VBA: Array & countIf

Question

Alle,

ich auf dem Ansatz habe Schwierigkeiten für den folgenden Fall in Excel VBA zu nehmen:

Von verschiedenen Blättern ich in VBA ein Array erstellt (4 Spalten: Schlüssel, Typ , das Datum der Aktivität A, das Datum der Aktivität B), zB:

entschied ich mich nicht ein Wörterbuch zu verwenden, da die Größe des Arrays (die Anzahl der Autos) gegeben. Ich habe auch nicht einfache Copy-Paste-Makros + Countif verwendet. Vor allem, stimmen Sie zu, dass ein Array in VBA der beste Ansatz ist?

Jetzt möchte ich Ergebnisse pro Aktivität haben, wie dies in einer Tabelle zusammengefasst:

So, jetzt bin ich zu kämpfen, was der beste Ansatz ist: 1) Looping über die Leitungen in der Anordnung und fügen Sie den Werten eins nach dem anderen in der Tabelle 2) Looping über die Zellen in der Tabelle und finden auf einem separaten Blatt Kopieren entsprechenden Autos 3) und countIf in der Tabelle 4) verwenden ...

Könnten Sie bitte er lp in der Beratung? Hoffentlich ist das Problem klar.

Answer 1

einige Helfer Spalten hinzufügen in (Sie können diese später ausblenden, wenn Sie möchten)

In Zelle D2 die Formel =MONTH(C2), Cell E2 ist =YEAR(C2) und das gleiche für G und H aber auf Spalte F

Dann in Ihrer Ergebnistabelle ich die Formel verwendet habe

=COUNTIFS($B$2:$B$4,$A8, $D$2:$D$4,MONTH(B$7),$E$2:$E$4,YEAR(B$7)) 

für die Aktivität A kann die gleiche Formel für Aktivität B verwendet werden (aber unter Verwendung von Säulen G und H statt D und E Ihre Ergebnisse zu erhalten. Keine Notwendigkeit für VBA

Aktualisierung mit vba Ansatz

Sie können auch diese VBA Ansatz versuchen. Sie müssen die Kommentare in Großbuchstaben beachten und für Ihre Eingabe und Ausgabe aktualisieren. Der Code nimmt Ihr Eingabe-Array und nimmt alles an, nachdem Spalte 2 ein Aktivitätsdatum ist. Es wird dann die Ergebnisse kompilieren und auf das Blatt zurückschreiben. Dies kann für jeden Datumsbereich funktionieren, da automatisch das erste und das letzte Datum (alle Daten im Jahr) sowie eine beliebige Anzahl von Aktivitäten ermittelt werden. Es gibt viele Schleifen hier wegen der Flexibilität von allem, aber da es alles in Arrays/Wörterbüchern (d. H. Im Speicher) behandelt wird, sollten Sie kein Leistungsproblem bekommen. Sie könnten es wahrscheinlich in weniger tun, aber das sollte es in Sekunden verarbeiten, unabhängig von der Größe des Datensatzes, so dass sich die Mühe nicht wirklich lohnt.

Option Explicit 
Public Sub GenerateResults() 
    Dim arr As Variant, tmp As Variant, Dates() As Double, Results As Object 
    Dim i As Long, j As Long, StartRow As Long, ResultsSeparator As Long 
    Dim StartYear As Long, EndYear As Long, yr As Long, mo As Long 
    Dim c 

    ' ******UPDATE TO POINT AT YOUR ARRAY****** 
    With Sheet1 
     arr = Range(.Cells(1, 1), .Cells(4, 5)).Value2 
    End With 

    Set Results = CreateObject("Scripting.Dictionary") 

    For j = 3 To UBound(arr, 2) 
     If StartYear < Format(WorksheetFunction.Min(Application.Index(arr, 0, j)), "yyyy") Then 
      StartYear = Format(WorksheetFunction.Min(Application.Index(arr, 0, j)), "yyyy") 
     End If 
     If EndYear < Format(WorksheetFunction.Max(Application.Index(arr, 0, j)), "yyyy") Then 
      EndYear = Format(WorksheetFunction.Max(Application.Index(arr, 0, j)), "yyyy") 
     End If 
    Next j 

    ' 1 to 12 for months in the year, 1 to 2 for each activitity. This could be adapated for more then 12 months 
    ReDim Dates(1 To (1 + EndYear - StartYear) * 12, 1 To UBound(arr, 2) - 2) 

    For i = LBound(arr) To UBound(arr) 
     Set tmp = Nothing 
     ' Add to dictionary if colour not in array 
     If Not Results.exists(arr(i, 2)) Then Results.Add Key:=arr(i, 2), Item:=Dates 
     ' Assign your data to a temporary array so we can change it 
     tmp = Results(arr(i, 2)) 
     ' Update data with activity dates 
     For j = LBound(Dates, 2) To UBound(Dates, 2) 
      tmp(12 * (Year(arr(i, 2 + j)) - StartYear) + Month(arr(i, 2 + j)), j) = tmp(12 * (Year(arr(i, 2 + j)) - StartYear) + Month(arr(i, 2 + j)), j) + 1 
     Next j 
     ' Write data back to dictionary 
     Results(arr(i, 2)) = tmp 
    Next i 

    Application.ScreenUpdating = False 
    ' ******CHANGE TO WHERE YOUR WANT YOUR RESULTS****** 
    ' Starting row of results (change to your output) 
    StartRow = 7 
    ' How many rows do you want between Activity A and B etc. 
    ResultsSeparator = 3 

    With Sheet1 
     For j = LBound(Dates, 2) To UBound(Dates, 2) 
      With .Cells(StartRow + (j - 1) * (ResultsSeparator + Results.Count), 1) 
       .Value2 = UCase("Activity " & Split(.Cells(1, j).Address, "$")(1)) 
       .Font.Bold = True 
      End With 
     Next j 
     StartRow = StartRow + 1 
     For j = LBound(Dates, 1) To UBound(Dates, 1) 
      yr = StartYear + IIf(j Mod 12 = 0, (j/12) - 1, WorksheetFunction.RoundDown(j/12, 0)) 
      mo = IIf(j > 12, j - 12 * IIf(j Mod 12 = 0, (j/12) - 1, WorksheetFunction.RoundDown(j/12, 0)), j) 
      For i = LBound(Dates, 2) To UBound(Dates, 2) 
       With .Cells(StartRow + (i - 1) * (ResultsSeparator + Results.Count), 1 + j) 
        .Value2 = DateSerial(yr, mo, 1) 
        .NumberFormat = "mmm-yy" 
       End With 
      Next i 
     Next j 
     StartRow = StartRow + 1 
     ' Loop through dictionary 
     For Each c In Results.keys 
      ' Write back results for Activity A 
      For j = LBound(Dates, 2) To UBound(Dates, 2) 
       With .Cells(StartRow + (j - 1) * (ResultsSeparator + Results.Count), 1) 
        .Value2 = c 
        Range(.Offset(0, 1), .Offset(0, UBound(Results(c), 1))) = Application.Transpose(Application.Index(Results(c), 0, j)) 
       End With 
      Next j 
      ' Increase Row 
      StartRow = StartRow + 1 
     Next c 
    End With 
    Application.ScreenUpdating = True 
End Sub