Question

我有一个excel“Sheet4”，如下所示：

Name    Cost   Code   Type
Item 1   $10           A
Item 2     -    PR6    A
Item 3   $15           B
Item 4     -    PR2    B
Item 5   $15           B

然后是第二个“Sheet3”，如下所示：

Code  PR6
CLR   $10   GRY   $12   BRN   $12
GRN   $12   RED   $13   GRX   $17

Code  PR2
CLR   $12   GRY   $14   BRN   $14
GRN   $14   RED   $14   GRX   $20

我需要做的是构建一个宏来查找sheet1中空白价格值的代码，并从sheet2中复制不同颜色的多个价格，以便sheet1中的最终读数如下所示：

Name    Cost   Code   Type
Item 1   $10           A
Item 2   $10    CLR    A
Item 2   $12    GRY    A
Item 2   $17    GYX    A
Item 3   $15           B
Item 4   $12    CLR    B
Item 4   $14    GRY    B
Item 4   $20    GYX    B
Item 5   $15           B

sheet2中的所有颜色和价格都在不同的单元格中。

我只需要为每个颜色使用相同的颜色（即需要复制CLR，GRY和GYX）但是在sheet2中会有某些组没有所需的颜色（一个可能只有CLR和GYX没有GRY）。

我已经尝试了下面的代码，但我认为它很难，因为我使用Offset在“item”范围内引用一个单元格，它说“对象不支持此属性或方法”。我需要能够将Sheet3中的值粘贴到Sheet4中的右列;列B和C分别为。

如果我能让下面的代码工作，我唯一要做的就是为每个相应的颜色添加Elseif语句，然后让它插入行并复制要填充的行。

Sub productsTest（）

Dim st1, st2 As Worksheet
Set st1 = Sheets("Sheet4")
Set st2 = Sheets("Sheet3")
Dim items As Range
Set items = st1.Range(st1.Range("A1"), st1.Range("A" & Rows.Count).End(xlUp))
Dim item As Range

For Each item In items
    Dim cost As String
    Dim code As String
    Dim t As String
    cost = item.Offset(0, 1).Value
    code = item.Offset(0, 2).Value
    t = item.Offset(0, 3).Value
    If cost = "0" Then
        Dim prodPos As Range
        Dim prodColors As Range
        Dim prodColor As Range
        Dim colorcost As String
        Dim color As String

        Set prodPos = st2.Cells.Find(What:=code, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        Set prodColors = Range(prodPos.Offset(1, -1), prodPos.Offset(6, 6))

        For Each prodColor In prodColors
            If prodColor.Value = "CLR" Then
                color = prodColor.Value
                colorcost = prodColor.Offset(0, 1).Value
                   'This is where its encountering a problem
                Worksheets("Sheet4").item.Offset(0, 2).Activate
                ActiveCell.Value = color
                st1.item.Offset(0, 1).Value = colorcost
            End If
        Next prodColor

    End If
Next item

End Sub

Answer 1

希望这会对你有所帮助：

Sub productsPrice()

    Dim st1, st2 As Worksheet
    Set st1 = Sheets("sheet1")
    Set st2 = Sheets("sheet2")
    Dim items As Range
    Set items = st1.Range(st1.Range("A2"), st1.Range("A" & Rows.Count).End(xlUp))
    Dim item As Range
    For Each item In items
        Dim cost As String
        Dim code As String
        Dim t As String
        cost = item.Offset(0, 1).Value
        code = item.Offset(0, 2).Value
        t = item.Offset(0, 3).Value
        If cost <> "-" Then
            MsgBox (item & ", " & cost & ", " & code & ", " & t)
        Else
            Dim prodPos As Range
            Dim prodColors As Range
            Dim prodColor As Range
            Set prodPos = st2.Cells.Find(What:=code, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            Set prodColors = Range(prodPos.Offset(1, -1), prodPos.Offset(2, 4))
            Dim index As Integer
            index = 0
            For Each prodColor In prodColors
                If index Mod 2 = 0 Then
                    MsgBox (prodColor & ", " & prodColor.Offset(0, 1) & ", " & code & ", " & t)
                End If
                index = index + 1
            Next prodColor
        End If
    Next item

End Sub

而不是MsgBox，只需将结果放在适当的位置即可。

Answer 2

我解决了这个问题：

Sub productsTest()

Dim st1, st2 As Worksheet
Set st1 = Sheets("Sheet4")
Set st2 = Sheets("Sheet3")
Dim items As Range
Set items = st1.Range(st1.Range("A1"), st1.Range("A" & Rows.Count).End(xlUp))
Dim item As Range

For Each item In items
    Dim cost As String
    Dim code As String
    Dim R As Long
    Dim C As Long
    item.Activate
    R = ActiveCell.Row
    C = ActiveCell.Column
    cost = item.Offset(0, 1).Value
    code = item.Offset(0, 2).Value
    If cost = "0" Then
        Dim prodPos As Range
        Dim prodColors As Range
        Dim prodColor As Range
        Dim colorcost As String
        Dim color As String

        Set prodPos = st2.Cells.Find(What:=code, LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        Set prodColors = Range(prodPos.Offset(1, -1), prodPos.Offset(6, 6))

        'I added a For statement for each color
        For Each prodColor In prodColors
            If prodColor.Value = "CLR" Then
                color = prodColor.Value
                colorcost = prodColor.Offset(0, 1).Value
                st1.Cells(R, C).Offset(0, 2).Value = color
                st1.Cells(R, C).Offset(0, 1).Value = colorcost
            End If
        Next prodColor
        For Each prodColor In prodColors
            If prodColor.Value = "PGX" Then
                color = prodColor.Value
                colorcost = prodColor.Offset(0, 1).Value
                st1.Range("A" & R & ":D" & R).Select
                Selection.Copy
                Selection.Insert Shift:=xlDown
                st1.Cells(R, C).Offset(0, 2).Value = color
                st1.Cells(R, C).Offset(0, 1).Value = colorcost
            End If
        Next prodColor
        For Each prodColor In prodColors
            If prodColor.Value = "TGY" Then
                color = prodColor.Value
                colorcost = prodColor.Offset(0, 1).Value
                st1.Range("A" & R & ":D" & R).Select
                Selection.Copy
                Selection.Insert Shift:=xlDown
                st1.Cells(R, C).Offset(0, 2).Value = color
                st1.Cells(R, C).Offset(0, 1).Value = colorcost
            End If
        Next prodColor
                    For Each prodColor In prodColors
            If prodColor.Value = "TVG" Then
                color = prodColor.Value
                colorcost = prodColor.Offset(0, 1).Value
                st1.Range("A" & R & ":D" & R).Select
                Selection.Copy
                Selection.Insert Shift:=xlDown
                st1.Cells(R, C).Offset(0, 2).Value = color
                st1.Cells(R, C).Offset(0, 1).Value = colorcost
            End If
        Next prodColor
                    For Each prodColor In prodColors
            If prodColor.Value = "GYC" Then
                color = prodColor.Value
                colorcost = prodColor.Offset(0, 1).Value
                st1.Range("A" & R & ":D" & R).Select
                Selection.Copy
                Selection.Insert Shift:=xlDown
                st1.Cells(R, C).Offset(0, 2).Value = color
                st1.Cells(R, C).Offset(0, 1).Value = colorcost
            End If
        Next prodColor
                    For Each prodColor In prodColors
            If prodColor.Value = "PGX" Then
                color = prodColor.Value
                colorcost = prodColor.Offset(0, 1).Value
                st1.Range("A" & R & ":D" & R).Select
                Selection.Copy
                Selection.Insert Shift:=xlDown
                st1.Cells(R, C).Offset(0, 2).Value = color
                st1.Cells(R, C).Offset(0, 1).Value = colorcost
            End If
        Next prodColor
    End If
Next item

End Sub

找到一个单元格值，在另一个工作表中查找相应的代码并复制多个对应的值

2 个答案: