Wie kann ich ein Array in einer IF-Funktion erstellen

Question

Ich bin neu bei VBA und Codierung. Mein Problem ist wie folgt: Ich habe eine Reihe von Daten in einer Tabelle, die nach den Namen des Kunden und dem Tag der Bestellung Produkt entspricht. Was ich tun muss, ist ein neues Array in einer anderen Tabelle zu erstellen, wo ich jeden Kunden (ohne sich zu wiederholen) in Spalte A und das zugehörige Bestelldatum für jeden Kunden in Spalte B, C usw. auflisten lassen kann. Im Grunde geht es darum, die Rohdaten in nützliche Daten umzuwandeln. Ich würde wirklich jede Art von Hilfe schätzen !! Die VBA sieht wie folgt aus:

Sub Test_1() 
Application.ScreenUpdating = False 

' Statment 

Dim Client As String 
Dim Order_date As Date 
Dim Counter As Integer 
Dim Data As Worksheet 
Dim Data_storage As Worksheet 
Dim i As Integer 

Counter = 10 

' Core 
' For every value in column B *This values are going to be clients names * They are going to be repeated value in this column *This data is in the Data spreadsheet 

' When the counter begins, if new Client is detected 
' Then paste in worksheet Data_storage in column A and paste in column B the Order_date value *Every Client will have a order date associated 

' If's a repeated Client, only paste the Order_date value in the next column with no value of the existing Client 



End Sub 

Answer 1

Ihre "Quelle" Daten unter der Annahme:

• sind in der Spalte "B"

• Start aus Reihe 1, mit einem "Header"

dann können Sie versuchen, diesen Code:

Option Explicit 

Sub Test_1() 
    Dim sourceRng As Range, pasteRng As Range, cell As Range 

    Set pasteRng = Worksheets("Data_storage").Range("A1") '<--| set the upper-left cell in "paste" sheet 

    With Worksheets("Data") '<--| reference "source" sheet 
     Set sourceRng = .Range("C1", .Cells(.Rows.Count, "B").End(xlUp)) '<--| set the "source" range to columns "B:C" from row 1 down to last non empty cell in column "B" 
    End With 

    With sourceRng '<--| reference "source" range 
     .Sort key1:=.Range("A1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending, header:=xlYes '<--| sort it by its column 1 and then by its column 2 
     pasteRng.Resize(.Rows.Count).value = .Resize(, 1).value '<--| paste its column 1 values to "Paste" sheet column 1 
     pasteRng.CurrentRegion.RemoveDuplicates Columns:=Array(1) '<--| leave only unique values in "paste" range 
     Set pasteRng = pasteRng.Range(pasteRng.Offset(1), pasteRng.End(xlDown)) '<--| skip "paste" range header 
     For Each cell In pasteRng '<--| loop through unique values in "paste" range column 1 
      .AutoFilter field:=1, Criteria1:=cell.value '<--| filter "source" range column 1 with current unique value 
      .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Copy '<--| copy "source" range" column 2 filtered cells 
      cell.Offset(, 1).PasteSpecial Transpose:=True '<--| ... and paste/transpose them aside current unique value in "paste" range 
     Next cell 
     .Parent.AutoFilterMode = False '<--| .. show all rows back... 
    End With 
End Sub