簡體   English   中英

VBA-根據多個條件從另一張紙復制單元格

[英]VBA - copy cells from another sheet based on multiple criteria

我是VBA的新手,感覺很糟糕。 我有兩個工作表。 我必須根據每個客戶的地址向每個客戶分配一個銷售人員。 在Sheet1上,我使用三個數據列,郵政編碼(K),城市(I)和國家(L)。 在Sheet2上,我在B列和C列(低和高值),城市(D)和國家(E)中有一個郵政編碼范圍。 每行中都有分配的銷售人員的姓名。

代碼要求:檢查客戶所在的國家/地區是否與第一個銷售人員所在的國家/地區匹配。 如果是,請檢查客戶的郵政編碼是否在范圍內。 如果匹配,將銷售人員姓名復制到Sheet1,然后移至下一行。 如果在Sheet2上沒有給出作為標准的郵政編碼范圍,或者在客戶的郵政編碼上沒有匹配項,請檢查City是否匹配,是否有匹配的銷售人員姓名復制到Sheet1,然后移至下一行。 如果在Sheet2上沒有給出任何城市作為標准,或者在客戶的城市上沒有匹配項,請檢查國家/地區是否匹配,然后將銷售人員姓名復制到Sheet1。

到目前為止,這是怎么回事:

`Sub Territory()
    Dim i As Integer
    Dim sh1 As Worksheet, sh2 As Worksheet
   Dim sh1Rws As Long, sh1Rng As Range, s1 As Range
   Dim sh2lowRws As Long, sh2lowRng As Range, s2l As Range
   Dim sh2highRws As Long, sh2highRng As Range, s2h As Range

   Set sh1 = Sheets("Sheet1")
   Set sh2 = Sheets("Sheet2")
   Set i = 1
   With sh1
        sh1Rws = .Cells(Rows.Count, "K").End(xlUp).Row
        Set sh1Rng = .Range(.Cells(1, "K"), .Cells(sh1Rws, "K"))
    End With

    With sh2l
        sh2lowRws = .Cells(Rows.Count, "B").End(xlUp).Row
        Set sh2lowRng = .Range(.Cells(1, "B"), .Cells(sh2lowRws, "B"))
    End With
    With sh2h
        sh2highRws = .Cells(Rows.Count, "C").End(xlUp).Row
        Set sh2highRng = .Range(.Cells(1, "C"), .Cells(sh2highRws, "C"))
    End With

    For Each s1 In sh1Rng
        For Each s2l In sh2lowRng
            If s1 > s2l And s1 < s2h Then sh2lowRws.Copy       Destination:=Sheet.sh1.Range("u", i)
            End If
            Set i = i + 1

    End Sub`

嘗試以下代碼,讓我知道它是否有效或需要更改

Sub test()
i = Sheets(1).Range("a1048576").End(xlUp).Row
l = Sheets(2).Range("a1048576").End(xlUp).Row

    For k = 2 To i
        For x = 2 To l
        CityCus = Sheets(1).Range("I" & k).Value
        CitySales = Sheets(2).Range("D" & x).Value

        CotyCus = Sheets(1).Range("L" & k).Value
        CotySales = Sheets(2).Range("E" & x).Value

        ZipCus = Sheets(1).Range("K" & k).Value
        ZipUpperSales = Sheets(2).Range("B" & x).Value
        ZiplowerSales = Sheets(2).Range("C" & x).Value

        c = Sheets(1).Range("b" & k).Value
        d = Sheets(2).Range("A" & x).Value

            If CotyCus = CotySales Then
                If CityCus = CitySales Then

                     If ZipCus <= ZiplowerSales And ZipCus >= ZipUpperSales Then

                       Sheets(1).Range("b" & k).Value = Sheets(2).Range("A" & x).Value
                     End If
                End If
             End If
        Next
    Next
End Sub

暫無
暫無

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

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