Wie erstellt man dynamisch ein Array mit nur ausgewählten Datenspalten in einem Arbeitsblatt

Question

Ich habe eine Arbeitsmappe, die ein Arbeitsblatt als Datenquelle und 5 andere Arbeitsblätter, die druckbare Berichte sind, hat. Das Datenarbeitsblatt hat einen Bereich von 34 Spalten zu 240 Zeilen. Ich muss ein Array von bestimmten Spalten wie 1,3-6, 11, 14, 17-24, 29 & 34 kompilieren. Dann durchsuchen Sie die Array-Zeile 1 nach einer bestimmten Kategorie von Daten und schreiben Sie dann alle Zeilen mit dieser Kategorie, wenn es 1 oder 100 ist, zu einem anderen Arbeitsblatt.

Answer 1

Danke für die Push in die richtige Richtung "Garys Student". Dies ist, was es entwickelt hat, was nur Teil 1 von 4 ist. Manchmal brauchen Sie nur einen Schubs, um das Gehirn zum Laufen zu bringen.

Function Applications() 

Dim i As Long 
Dim j As Long 
Dim k As Long 
Dim x As Long 
Dim y As Long 
Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim ws3 As Worksheet 
Dim ws4 As Worksheet 
Set ws1 = Worksheets("Traffic") 
Set ws2 = Worksheets("Processing Apps") 
Set ws3 = Worksheets("Approved Apps") 
Set ws4 = Worksheets("Denied Apps") 

Dim ColLast1 As Long, RowLast As Long, FullName As Long, SubDate As Long, Wants As Long, _ 
    PosUnit As Long, MoveInDate As Long, AppDep As Long, LSent As Long, LRec As Long, ESent As Long, _ 
    ERec As Long, SSent As Long, SRec As Long, SexOff As Long, Crim As Long, Correct As Long, _ 
    PreApp As Long, Corp As Long, FU1Date As Long, FU1Note As Long, StatusCode As Long 

    With ws1 
    ColLast1 = .Cells(1, Columns.Count).End(xlToLeft).Column 
    RowLast = .Cells(Rows.Count, 1).End(xlUp).Row 
     With .Range(.Cells(1, 1), .Cells(1, ColLast1)) 
      StatusCode = .Find("Code").Column 
      FullName = .Find("Full Name").Column 
      SubDate = .Find("Submit").Column 
      Wants = .Find("Wants").Column 
      PosUnit = .Find("Punit").Column 
      MoveInDate = .Find("MIDate").Column 
      AppDep = .Find("App/Dep").Column 
      LSent = .Find("LLSent").Column 
      LRec = .Find("LLRecieved").Column 
      ESent = .Find("EMSent").Column 
      ERec = .Find("EMRecieved").Column 
      SSent = .Find("ShanSent").Column 
      SRec = .Find("ShanRecieved").Column 
      SexOff = .Find("SO").Column 
      Crim = .Find("Criminal").Column 
      Correct = .Find("Corrections").Column 
      PreApp = .Find("Prelim").Column 
      Corp = .Find("SentToCorp").Column 
      FU1Date = .Find("AppFU1Date").Column 
      FU1Note = .Find("AppFU1").Column 
     End With 
    End With 

    k = 1 
    ReDim data(1 To (RowLast), 1 To 19) As Variant 

    For i = 10 To RowLast 

     Select Case ws1.Cells(i, StatusCode).Value 

      Case "W" 

       AppWorking = Array(FullName, SubDate, Wants, PosUnit, MoveInDate, AppDep, LSent, LRec, _ 
          ESent, ERec, SSent, SRec, SexOff, Crim, Correct, PreApp, Corp, FU1Date, FU1Note) 

         j = 1 

         For Each A In AppWorking 

           data(k, j) = ws1.Cells(i, A).Value 

          j = j + 1 

         Next A 

         k = k + 1 

     End Select 

    Next i 

    x = UBound(data, 1) - LBound(data, 1) + 1 
    y = UBound(data, 2) - LBound(data, 2) + 1 

    Range("ProcessingDataField").Resize(x, y) = data 
    Sheet7.Activate 

End Function 

Answer 2

Hier ist ein Weg, um das Array zu erstellen:

Sub dural() 
    Dim i As Long, j As Long 
    ary = Array(1, 3, 4, 5, 6, 11, 14, 17, 18, 19, 20, 21, 22, 23, 24, 29, 34) 
    ReDim Data(1 To 240, 1 To 17) As Variant 
    j = 1 
    For Each a In ary 
     For i = 1 To 240 
      Data(i, j) = Cells(i, a).Value 
     Next i 
     j = j + 1 
    Next a 
End Sub