Question

我是VBA和编码新手。我的问题如下：我在电子表格中有一系列数据符合客户名称和订单产品的日期。我需要做的是在不同的电子表格中创建一个新数组，我可以在列A上列出每个客户端（不重复），并在列B，C等上为每个客户端关联订单日期。所以基本上是将原始数据转换为有用的数据。我真的很感激任何类型的帮助！ 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

如何基于IF功能创建数组

1 个答案: