我如何创build一个基于IF函数的数组

我是VBA和编码的新手。 我的问题如下：我有一个电子表格中的数据符合客户的名字和订单产品的一天。 我需要做的是在不同的电子表格中创build一个新的数组，我可以在列A上列出每个客户端（不重复），列B上每个客户端的相关订单dateC等等。 所以基本上是把原始数据转换成有用的数据。 我真的很感激任何types的帮助！ VBA看起来如下：

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

假设你的“源”数据：

• 在列“B”

• 从第1行开始，用“标题”

那么你可以试试这个代码：

 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