戻る

Sub 地上開度()
'
    Dim I, J, n, retu, gyo, Dxn, Dyn, Dxyn, xb, xe, yb, ye As Integer
    Dim k1, k2, k3, k4, k5, k6, k7, k8 As Double
    Dim k1t, k2t, k3t, k4t, k5t, k6t, k7t, k8t As Double
    Dim Dx, Dy, Dxy As Double
'
    Dxn = [X方向の検索セル数]   '検索距離/ピクセル幅
    Dyn = [Y方向の検索セル数]   '検索距離/ピクセル高さ
    Dxyn = [45°方向の検索セル数] '検索距離/ピクセル対角線長さ
    Dx = [ピクセル幅]
    Dy = [ピクセル高さ]
    Dxy = [ピクセル対角線長さ]
    xb = [開始行位置]
    yb = [開始列位置]
    xe = [終了行位置]
    ye = [終了列位置]
  gyo = xe - xb + 1
  retu = ye - yb + 1    
'
  For I = Dyn + 2 To gyo - Dyn + 1
    For J = Dxn + 1 To retu - Dxn
      k2 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J + 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dy
      k6 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J - 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dy
      k4 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + 1, J) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dx
      k8 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - 1, J) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dx
      k1 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - 1, J + 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dxy
      k3 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + 1, J + 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dxy
      k5 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + 1, J - 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dxy
      k7 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - 1, J - 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dxy
'
      For n = 2 To Dxn
        k2t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J + n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dy * n)
        k2 = WorksheetFunction.Max(k2, k2t)
        k6t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J - n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dy * n)
        k6 = WorksheetFunction.Max(k6, k6t)
      Next
      For n = 2 To Dyn
        k4t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + n, J) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dx * n)
        k4 = WorksheetFunction.Max(k4, k4t)
        k8t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - n, J) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dx * n)
        k8 = WorksheetFunction.Max(k8, k8t)
      Next
      For n = 2 To Dxyn
        k1t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - n, J + n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dxy * n)
        k1 = WorksheetFunction.Max(k1, k1t)
        k3t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + n, J + n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dxy * n)
        k3 = WorksheetFunction.Max(k3, k3t)
        k5t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + n, J - n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dxy * n)
        k5 = WorksheetFunction.Max(k5, k5t)
        k7t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - n, J - n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dxy * n)
        k7 = WorksheetFunction.Max(k7, k7t)
      Next
'
      k1 = WorksheetFunction.Atan2(1, k1)
      k2 = WorksheetFunction.Atan2(1, k2)
      k3 = WorksheetFunction.Atan2(1, k3)
      k4 = WorksheetFunction.Atan2(1, k4)
      k5 = WorksheetFunction.Atan2(1, k5)
      k6 = WorksheetFunction.Atan2(1, k6)
      k7 = WorksheetFunction.Atan2(1, k7)
      k8 = WorksheetFunction.Atan2(1, k8)
      Cells(I, J) = 90 - (k1 + k2 + k3 + k4 + k5 + k6 + k7 + k8) * 180 / Application.Pi() / 8
    Next
  Next
End Sub

Sub 地下開度()
'
    Dim I, J, n, retu, gyo, Dxn, Dyn, Dxyn, xb, xe, yb, ye As Integer
    Dim k1, k2, k3, k4, k5, k6, k7, k8 As Double
    Dim k1t, k2t, k3t, k4t, k5t, k6t, k7t, k8t As Double
    Dim Dx, Dy, Dxy As Double
'
    Dxn = [X方向の検索セル数]   '検索距離/ピクセル幅
    Dyn = [Y方向の検索セル数]   '検索距離/ピクセル高さ
    Dxyn = [45°方向の検索セル数] '検索距離/ピクセル対角線長さ
    Dx = [ピクセル幅]
    Dy = [ピクセル高さ]
    Dxy = [ピクセル対角線長さ]
    xb = [開始行位置]
    yb = [開始列位置]
    xe = [終了行位置]
    ye = [終了列位置]
  gyo = xe - xb + 1
  retu = ye - yb + 1
'
  For I = Dyn + 2 To gyo - Dyn + 1
    For J = Dxn + 1 To retu - Dxn
      k2 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J + 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dy
      k6 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J - 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dy
      k4 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + 1, J) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dx
      k8 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - 1, J) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dx
      k1 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - 1, J + 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dxy
      k3 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + 1, J + 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dxy
      k5 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + 1, J - 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dxy
      k7 = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - 1, J - 1) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / Dxy
'
      For n = 2 To Dxn
        k2t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J + n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dy * n)
        k2 = WorksheetFunction.Min(k2, k2t)
        k6t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J - n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dy * n)
        k6 = WorksheetFunction.Min(k6, k6t)
      Next
      For n = 2 To Dyn
        k4t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + n, J) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dx * n)
        k4 = WorksheetFunction.Min(k4, k4t)
        k8t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - n, J) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dx * n)
        k8 = WorksheetFunction.Min(k8, k8t)
      Next
      For n = 2 To Dxyn
        k1t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - n, J + n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dxy * n)
        k1 = WorksheetFunction.Min(k1, k1t)
        k3t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + n, J + n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dxy * n)
        k3 = WorksheetFunction.Min(k3, k3t)
        k5t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I + n, J - n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dxy * n)
        k5 = WorksheetFunction.Min(k5, k5t)
        k7t = (Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I - n, J - n) - Range(Worksheets(1).Cells(xb, yb), Worksheets(1).Cells(xe, ye)).Cells(I, J)) / (Dxy * n)
        k7 = WorksheetFunction.Min(k7, k7t)
      Next
'
      k1 = WorksheetFunction.Atan2(1, k1)
      k2 = WorksheetFunction.Atan2(1, k2)
      k3 = WorksheetFunction.Atan2(1, k3)
      k4 = WorksheetFunction.Atan2(1, k4)
      k5 = WorksheetFunction.Atan2(1, k5)
      k6 = WorksheetFunction.Atan2(1, k6)
      k7 = WorksheetFunction.Atan2(1, k7)
      k8 = WorksheetFunction.Atan2(1, k8)
      Cells(I, J) = 90 + (k1 + k2 + k3 + k4 + k5 + k6 + k7 + k8) * 180 / Application.Pi() / 8
    Next
  Next
End Sub


戻る