簡體   English   中英

根據單元格值將數據從一張紙移動到另一張紙

[英]Moving Data from One Sheet to Another Based on Cell Value

我有一個電子表格“上載”,我運行一個宏來編譯工作表上的數據。 我有一列“ D”,該列將數據歸因於客戶端。 我想尋找一個特定的客戶端,並自動將這些行移動到另一個工作表。 我已經嘗試過此代碼,但出現錯誤“ Upload.Range(“ D1”,Upload.Range(“ D”&Upload.Rows.Count)“

我預計將來的客戶信息也需要與初始電子表格分開。

任何幫助將非常感激

Sub TransferData()

        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long

ar = Array("3032")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

  For i = 0 To UBound(ar)
         Upload.Range("D1", Upload.Range("D" & Upload.Rows.Count).End(xlUp)).AutoFilter 1, ar(i), 4, , 0
         lr = Upload.Range("D" & Rows.Count).End(xlUp).Row
         If lr > 1 Then
         Upload.Range("A2", Upload.Range("G" & Upload.Rows.Count).End(xlUp)).Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
         Upload.Range("A2", Upload.Range("G" & Upload.Rows.Count).End(xlUp)).Delete
         Sheets(ar(i)).Columns.AutoFit
         End If
    Next i
[G1].AutoFilter

Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub

工作表的“名稱”屬性和工作 表的“代碼名”屬性之間存在實質性差異。

雖然可以更改工作表的代號,但這不是常見的做法,如果不確定,則很可能是在引用工作表的Name屬性。

您的敘述並沒有說要獲得“最低10個結果”,但是您的代碼對xlBottom10Items運算符使用4 (請參見xlAutoFilterOperator枚舉 )。

我不知道在3 Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)旨在表示。 我想您的意思是xlUp ,其數值為-4162 (請參閱xlDirection枚舉 )。

Sub TransferData()

    Dim ar As Variant
    Dim i As Long, lr As Long

    ar = Array("3032")

    ' ... app environment settings removed for brevity

    'reference the filter worksheet properly
    With Worksheets("Upload")
        lr = .Range("D" & Rows.Count).End(xlUp).Row
        If .AutoFilterMode Then .AutoFilterMode = False
        For i = LBound(ar) To UBound(ar)
            'there was no mention of 'bottom 10 items in your narrative but your code shows that option
            With .Range("D1:D" & lr)
                '.AutoFilter field:=1, Criteria1:=ar(i), _
                            Operator:=xlBottom10Items, VisibleDropDown:=False
                .AutoFilter field:=1, Criteria1:=(ar(i)), VisibleDropDown:=False

                With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                    If CBool(Application.Subtotal(103, .Cells)) Then
                        .Offset(0, -3).Resize(, 7).Copy _
                          Destination:=Worksheets(ar(i)).Range("A" & Rows.Count).End(xlUp)(2)
                        Worksheets(ar(i)).Columns.AutoFit
                        .Delete shift:=xlUp
                    End If
                End With
            End With
        Next i
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

    ' ... app environment settings removed for brevity

    MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub

那應該讓您開始。 根據我的筆記,您似乎仍有一些決定要做出。

Application.CutCopyMode =假

請參閱退出子過程之前是否應該重新打開.CutCopyMode?

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM