简体   繁体   English

VBA-根据多个条件从另一张纸复制单元格

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

I'am new to VBA and got stuck real bad. 我是VBA的新手,感觉很糟糕。 I have two worksheets. 我有两个工作表。 I have to assign a sales person to every customer based on their address. 我必须根据每个客户的地址向每个客户分配一个销售人员。 On Sheet1 I use three data columns, Zip (K), City (I) and Country (L). 在Sheet1上,我使用三个数据列,邮政编码(K),城市(I)和国家(L)。 On Sheet2 I have a Zip code range in column B and C (low and high value), the City (D) and the Country (E). 在Sheet2上,我在B列和C列(低和高值),城市(D)和国家(E)中有一个邮政编码范围。 In every row there is the name of the assigned sales person. 每行中都有分配的销售人员的姓名。

The requirements for the code: Check if customer's country matches with the first sales persons country. 代码要求:检查客户所在的国家/地区是否与第一个销售人员所在的国家/地区匹配。 If yes check if customer's zip code is in range. 如果是,请检查客户的邮政编码是否在范围内。 If there is a match copy sales person name to Sheet1 and move to next row. 如果匹配,将销售人员姓名复制到Sheet1,然后移至下一行。 If no Zip range is given on Sheet2 as criteria or there is no match on customer's zip, check if City matches, if there is a match copy sales person name to Sheet1 and move to next row. 如果在Sheet2上没有给出作为标准的邮政编码范围,或者在客户的邮政编码上没有匹配项,请检查City是否匹配,是否有匹配的销售人员姓名复制到Sheet1,然后移至下一行。 If no city is given on Sheet2 as criteria or there is no match on customer's city,check if country matches and copy sales persons name to Sheet1. 如果在Sheet2上没有给出任何城市作为标准,或者在客户的城市上没有匹配项,请检查国家/地区是否匹配,然后将销售人员姓名复制到Sheet1。

This is what if have so far: 到目前为止,这是怎么回事:

`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`

Try the below code and let me know if it works or changes required 尝试以下代码,让我知道它是否有效或需要更改

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.

相关问题 VBA附加-根据条件将单元格从一张纸复制到另一张纸 - VBA Append - copy cells froma sheet to another based to a criteria 根据另一个单元格中的条件将单元格从一个工作表复制到另一个工作表 - Copy cells from one sheet to another based on criteria in another cell VBA将符合条件的单元格复制到另一张工作表 - VBA copy cells that meet criteria to another sheet VBA - 根据汇总 Excel 表格上的条件,将工作簿中的不同模板工作表复制到另一个工作簿的多张工作表中 - VBA - copy different template sheets from a workbook, into multiple sheets of another workbook based on criteria on a summary excel sheet VBA 将多个工作簿中的一个单元格复制到另一个工作表中的特定单元格中 - VBA to copy a cell from multiple workbooks into specific cells in the another sheet 根据多个单元格中的条件将一行中的单元格(不是整行)复制到另一个工作表 - Copy cells in a row (not entire row) based on criteria in multiple cells to another sheet 通过根据条件覆盖另一个工作表中的单元格来复制单元格和粘贴 - Copy cells and paste by overwriting cells in another sheet based on a criteria 如何根据多个条件将单元格从一个工作簿复制到另一个工作簿 - How to copy cells from one workbook to another based on multiple criteria 根据另一列中的条件将一列中的单元格复制到另一张工作表 - Copy Cells in One Column, Based on Criteria in Another Column, to Another Sheet Excel VBA根据条件从一张纸复制到另一张纸的特定单元格 - Excel VBA copy from one sheet to other sheets specific cells based on criteria
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM