2

IFを適用することは可能ですか..それからVBAの配列に? 私は次のコードを持っており、配列プラガに For Each と If を適用しています - 各 Interval の出現回数をカウントしますが、VBA は「範囲外の添え字」を返します。 .

Option Explicit
Public plaga As Variant

Sub dort()
  Dim cMin As Double
  Dim cMax As Double
  Dim lDer As Long

  Dim plaga() As Variant
  plaga = Worksheets("Sheet3").Range("A1:A10").Value

  Call tri1(plaga)

  cMin = WorksheetFunction.Min(plaga)
  cMax = WorksheetFunction.Max(plaga)

  Dim longInter As Double
  longInter = (cMax - cMin) / 3

  Dim pla As Variant
  Dim lCom As Long

  lDer = 2

  For Each pla In plaga
    If pla < cMin + longInter Then
      lCom = 1
    Else
      For lCom = lDer To 3
        If pla < cMin + longInter * lCom Then
          lDer = lCom
          Exit For
        End If
      Next
    End If
    plaga(lCom) = plaga(lCom) + 1
  Next

  Dim Destination As Range
  Set Destination = Worksheets("Sheet3").Range("B1")
  Destination.Resize(3, 1).Value = plaga

End Sub
4

1 に答える 1

1

サブルーチン tri1(plaga) で何が起こっているのかわかりませんが、これがあなたのコードの正しい表現だと思います。

Sub dort()
'
Dim cMin As Double
Dim cMax As Double
Dim lDer As Long
Dim plaga() As Variant
'
  ReDim Preserve plaga(10)
  plaga = Worksheets("Sheet3").Range("A1:A10").Value
  '
  Call tri1(plaga)
  '
  cMin = WorksheetFunction.Min(plaga)
  cMax = WorksheetFunction.Max(plaga)
  '
Dim longInter As Double
  longInter = (cMax - cMin) / 3
  '
Dim pla As Variant
Dim lCom As Long
  '
  lDer = 2
  '
  For Each pla In plaga
    If pla < cMin + longInter Then
      lCom = 1
    Else
      For lCom = lDer To 3
        If pla < (cMin + longInter) * lCom Then
          lDer = lCom
          Exit For
        End If
      Next
    End If
    plaga(lCom, 1) = plaga(lCom + 1, 1)
  Next
  '
Dim Destination As Range
  Set Destination = Worksheets("Sheet3").Range("B1:B1")
  Destination.Resize(3, 1).Value = plaga
'
End Sub

アップデート

注: longinter の整数を表示するために plaga2() を追加しました

Sub dort()

    Dim cMin As Double
    Dim cMax As Double
    Dim lDer As Long
    Dim plaga() As Variant
    Dim plaga2() As Variant


    ReDim Preserve plaga(10)
    ReDim Preserve plaga2(10)
    plaga = Worksheets("Sheet3").Range("A1:A10").Value
    plaga2 = Worksheets("Sheet3").Range("A1:A10").Value

    'Call tri1(plaga)

    cMin = WorksheetFunction.Min(plaga)
    cMax = WorksheetFunction.Max(plaga)

    Dim longInter As Double
    'In this case useing the numbers you stated
    'longinter = (7 - 1)/3 = 2
    longInter = (cMax - cMin) / 3

    Dim pla As Variant
    Dim lCom As Integer
    For lCom = 1 To 10
        If plaga(lCom, 1) >= (CMin + longInter) Then
            plaga(lCom, 1) = (plaga(lCom, 1) / longInter)
            plaga2(lCom, 1) = Int(plaga(lCom, 1))
        Else
            plaga(lCom, 1) = 1
            plaga2(lCom, 1) = 1
        End If
    Next

  Dim Destination1 As Range
  Set Destination1 = Worksheets("Sheet3").Range("B1:B1")
  Destination1.Resize(10, 1).Value = plaga

  Dim Destination2 As Range
  Set Destination2 = Worksheets("Sheet3").Range("C1:C1")
  Destination2.Resize(10, 1).Value = plaga2

End Sub
于 2013-04-14T09:50:53.773 に答える