根据可变条件将多个行中的多个值复制到一个单元格中

时间:2014-07-22 03:33:11

标签: excel-vba vba excel

正如主题所揭示的那样,我正在尝试根据可变条件从多个单元格和行复制数据。我的输入如下:

product size    type     length shoulder  
82HTHSG S       shirt    69     38.5      
82HTHSG M       shirt    74     39.5      
82HTHSG L       shirt    74     41.5      
82HTHSG XL      shirt    77     43       
84HTFSG S       tShirt   66     41        
84HTFSG M       tShirt   67.5   41        
84HTFSG L       tShirt   70     44.5     
84HTFSG XL      tShirt   73.5   46        

我想将产品(变量)中所有尺寸的数据合并到列中的字符串中。它应该看起来像这样(ex):

product size    type     length shoulder  result
82HTHSG S       shirt    69     38.5      Shoulder x 
                                          Length 
                                          - S  (69cm x 38.5cm)
                                          - M  (74cm x 39.5cm)
                                          - L  (Xcm x Xcm)
                                          - XL (Xcm x Xcm)  
82HTHSG M       shirt    74     39.5      Shoulder x 
                                          Length 
                                          - S  (69cm x 38.5cm)
                                          - M  (74cm x 39.5cm)
                                          - L  (Xcm x Xcm)
                                          - XL (Xcm x Xcm)   
(etc)                                       

到目前为止,我已经编写了以下代码:

Sub CombineText()
Dim i As Integer
i = 1

Do While Cells(i, 1).Value <> ""

If Cells(i, 5) = "shirt" Then

Cells(i, 22).Value = "Shoulder x" & Chr(10) & "Length" & Chr(10) & _
" - " & Cells(i, 3) & " (" & Cells(i, 9) & "cm x " & Cells(i, 16) & "cm)"
i = i + 1

ElseIf Cells(i, 5) = "tShirt" Then

Cells(i, 22).Value = "Shoulder x" & Chr(10) & "Length" & Chr(10) & _
" - " & Cells(i, 3) & " (" & Cells(i, 9) & "cm x " & Cells(i, 16) & "cm)"
i = i + 1

Else

Cells(i, 22).Value = 2
i = i + 1

End If

Loop

End Sub

代码给出以下结果(ex):

82HTHSG S       shirt    69     38.5      Shoulder x 
                                          Length 
                                          - S  (69cm x 38.5cm)
82HTHSG M       shirt    74     39.5      Shoulder x 
                                          Length 
                                          - M  (74cm x 39.5cm)

有关如何从同一产品中的其他尺寸复制数据并将其全部粘贴到列中的相邻单元格中的任何想法?

非常感谢所有帮助!

1 个答案:

答案 0 :(得分:0)

在您的宏中,您缺少类似于循环的东西,可以浏览一个产品代码的所有行以收集所有数据。下面是我的代码,用于检查您是否找到了与上一行不同的产品代码,如果是,则使用相同的产品代码执行以下行以获取所需的所有数据。

Sub CombineText()
Dim i, j As Integer
Dim result As String
i = 2

    Do While Cells(i, 1).Value <> ""

        'check if you are on first line mentioning new product code
        If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then

            If Cells(i, 5) = "shirt" Then
                result = "Shoulder x" & Chr(10) & "Length" & Chr(10)
                j = i

                'loop through following lines until you reach different product code
                While Cells(j, 1).Value = Cells(i, 1).Value
                    result = result & " - " & Cells(j, 3) & " (" & Cells(j, 9) & "cm x " & Cells(j, 16) & "cm)" & Chr(10)
                    j = j + 1
                Wend

            ElseIf Cells(i, 5) = "tShirt" Then
                result = "Shoulder x" & Chr(10) & "Length" & Chr(10)
                j = i

                'loop through following lines until you reach different product code
                While Cells(j, 1).Value = Cells(i, 1).Value
                    result = result & " - " & Cells(j, 3) & " (" & Cells(j, 9) & "cm x " & Cells(j, 16) & "cm)" & Chr(10)
                    j = j + 1
                Wend

            Else
                result = 2

            End If

            'fill in the first line for given product code
            Cells(i, 22).Value = result

        'for second and additional lines of the same product there is already correct result in previous line so just copy it
        Else
            Cells(i, 22).Value = Cells(i - 1, 22).Value

        End If

        i = i + 1

    Loop

End Sub

btw我将你的起始i从1移动到2,否则它会尝试检查第0行的值并导致错误。

我不确定为什么你基于“衬衫”和“T恤”划分它,因为我没有看到你的代码有什么不同,但我保留它以防万一我错过了某些东西或者你需要它用于别的东西。希望它有所帮助

的Pavel