VBA 동일한 항목을 반환하는 배열에서 항목 가져 오기

Question

JS에서 왔기 때문에 VBA에서 배열을 사용하는 방법은 매우 미흡했습니다. 이 때문에, 나는이 배열을 사용하여 2D 배열 내의 특정 항목의 색인을 찾습니다. 이 코드의 기본 개념은 일련의 보고서를 열어 배열에 저장하고 마스터 보고서의 현재 날짜와 일치시키는 방법에 따라 풀어내는 것입니다. 코드가 실행되지만 wkbArray의 첫 번째 항목에 대한 작업이 반복적으로 수행됩니다. 루프 카운터를 사용하여 배열 위치를 추적하려고 시도했지만 작동하지 않았습니다. 그래서 저는 그것들과 독립된 카운터를 만들었지 만, 그 중 하나는 작동하지 않는 것 같습니다. 그들은 전체 시간에 제로에 머물러 있기 때문입니다. 2D 배열에 대한 색인을 추적하는 더 좋은 방법에 대한 아이디어는 높이 평가됩니다. 나는 모든 사람이이 코드를 통과 할 것을 기대하지 않는다, 나는이 배열을 탐색하는 데 사용하려고하는 논리를 볼 수 있도록 모든 것을 포함하고있다.

Private Sub CommandButton1_Click() 

Dim wkb As Workbook 
Dim lastRow As Integer 
Dim lastColumn As Integer 
Dim i, t, j, z, r, k, w, f, u, e, d, v, n, p, b, aa As Integer 
Dim yesCount As Integer 
Dim finalArrayCount As Integer 
Dim lastDBRow As Integer 
Dim lastMacroRow As Long 
Dim verylastDBRow As Integer 
Dim bookName As String 
Dim bookDate As String 
Dim dateString As String 
Dim activePaste As String 
Dim matchDate As String 
Dim startColumn As Long 
startColumn = (Application.ActiveWorkbook.Sheets("Database(CU's)").Cells(3, Columns.Count).End(xlToLeft).Column) + 1 
Dim bookCount As Integer 
bookCount = Application.Workbooks.Count - 2 
Dim wkbArray() As String 
Dim duplicateArray() As Variant 
Dim finalArray() As Variant 
ReDim wkbArray((bookCount - 1), 1) As String 

'Loop through each workbook, store book name and date from X2 in a 2d array' 

Application.ActiveWorkbook.Sheets("macroPaste").Visible = True 

i = 0 
For Each wkb In Workbooks 
    If Left(wkb.Name, 15) = "CP_Inventory_By" Then 

     dateString = wkb.ActiveSheet.Range("X2").Value 
     bookName = wkb.Name 
     bookDate = Left(dateString, 5) 

     'Add book name and date to array' 

     wkbArray(i, 0) = bookName 
     wkbArray(i, 1) = bookDate 
     i = i + 1 
    Else 
    End If 
Next wkb 



'create loop to specify number of times to run paste operation' 

For t = 1 To bookCount 
    matchDate = Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("Database(CU's)").Cells(1, startColumn).Value 

     'Find book name based on match date' 
     d = 0 
     n = 0 
     For j = 0 To (bookCount - 1) 
      If wkbArray(d, 1) = matchDate Then 
      n = n + d 
      End If 
      d = d + 1 
     Next j 

     activePaste = wkbArray(n, 0) 
     With Workbooks(activePaste).Sheets("CP_Inventory_By_Run_Date_Email") 
      lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
     End With 

     'Set macroPaste Range equal to activePaste range, filter criteria.' 

     Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("macroPaste").Range(Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("macroPaste").Cells(1, 1), Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("macroPaste").Cells(lastRow, 24)).Value = Workbooks(activePaste).Sheets("CP_Inventory_By_Run_Date_Email").Range(Workbooks(activePaste).Sheets("CP_Inventory_By_Run_Date_Email").Cells(1, 1), Workbooks(activePaste).Sheets("CP_Inventory_By_Run_Date_Email").Cells(lastRow, 24)).Value 

     With Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("macroPaste") 
      lastMacroRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
      .Range(.Cells(1, 1), .Cells(lastMacroRow, 24)).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=.Range("AA1:AA12"), Unique:=False 
      .UsedRange.Copy 
     End With 

     'Paste in daily paste sheet, 

     With Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("Paste Daily Data") 
      .Range("E1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
      currentLastRow = .Cells(.Rows.Count, "E").End(xlUp).Row 
      yesCount = Application.WorksheetFunction.CountIf(.Range(.Cells(2, 3), .Cells(currentLastRow, 3)), "Yes") 
     End With 



     'Create Array of "YES Database Items' 
     If yesCount > 0 Then 
      With Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("Paste Daily Data") 

       ReDim duplicateArray(yesCount, 2) As Variant 
       r = 0 

       For z = 2 To currentLastRow 
        If .Cells(z, 3).Value = "Yes" Then 
         duplicateArray(r, 0) = .Cells(z, 5).Value 
         duplicateArray(r, 1) = .Cells(z, 6).Value 
         duplicateArray(r, 2) = .Cells(z, 9).Value 
         r = r + 1 
        Else 
        End If 
       Next z 
      End With 

      'Create final array with unique YES items' 
      ReDim finalArray(yesCount, 2) As Variant 
      finalArrayCount = 0 
      k = 0 
      f = 0 
      'Figure our how many times to loop through duplicate array' 
      p = 0 
      For k = 0 To yesCount 
       'Figure out if the value is already in the final array' 
       v = 0 
       aa = 0 
       For f = 0 To yesCount 
        If finalArray(aa, 1) = duplicateArray(p, 1) Then 
        v = v + 1 
        End If 
        aa = aa + 1 
       Next f 
       'if the value isn't in the final array, then add it. Otherwise, next k 
       If v = 1 Then 
        finalArray(p, 1) = duplicateArray(p, 1) 
        finalArray(p, 0) = duplicateArray(p, 0) 
        finalArray(p, 2) = duplicateArray(p, 2) 
        finalArrayCount = finalArrayCount + 1 
        p = p + 1 
       End If 

      Next k 

      'Add new values from finalArray to bottom of DatabaseCU sheet' 
      e = 0 
      b = 0 
      With Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("Database(CU's)") 
       lastDBRow = (.Cells(.Rows.Count, "D").End(xlUp).Row) + 1 
        For e = 0 To finalArrayCount - 1 
         .Cells(lastDBRow, 2).Value = finalArray(b, 0) 
         .Cells(lastDBRow, 3).Value = finalArray(b, 1) 
         .Cells(lastDBRow, 4).Value = finalArray(b, 2) 
         lastDBRow = lastDBRow + 1 
         b = b + 1 
        Next e 
      End With 
     End If 

     'fill down formula and move to next sheet' 


     With Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("Database(CU's)") 
      verylastDBRow = .Cells(.Rows.Count, "D").End(xlUp).Row 
      .Range(.Cells(2, startColumn), .Cells(2, startColumn)).AutoFill Destination:=.Range(.Cells(2, startColumn), .Cells(verylastDBRow, startColumn)), Type:=xlFillDefault 
      .Range(.Cells(2, startColumn), .Cells(verylastDBRow, startColumn)).Copy 
      .Range(.Cells(2, startColumn), .Cells(verylastDBRow, startColumn)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     End With 

     'Clear daily paste 
     With Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("Paste Daily Data") 
      .Range(Cells(2, 5), Cells(currentLastRow, 28)).Clear 
     End With 

     'clear macro paste 
     With Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("macroPaste") 
      .Range(.Cells(1, 1), .Cells(lastMacroRow, 24)).Clear 
      On Error Resume Next 
      .ShowAllData 
      On Error GoTo 0 
     End With 

     'Erase Arrays 
     Erase finalArray, duplicateArray 

     startColumn = startColumn + 1 
Next t 

Workbooks("CP Inventory Metrics with Pallets new.xlsm").Sheets("macroPaste").Visible = False 
End Sub 

Answer 1

Javascript 배열 기능은 JScript 플러그인을 통해 Excel VBA에서 사용할 수 있습니다.

본 기사로 안내합니다.

In Excel VBA on Windows, for parsed JSON variables what is this JScriptTypeInfo anyway?

스크롤 코드의 가장 낮은 부분 아래로.

Answer 2

당신은 항상 같은 값 출구

'Find book name based on match date' 
d = 0 
n = 0 
For j = 0 To (bookCount - 1) 
    If wkbArray(d, 1) = matchDate Then 
     n = n + d 
     exit for 'here 
    End If 
    d = d + 1 
Next j 

'You will then pick up the nth workbook in 
activePaste = wkbArray(n, 0)