Question

我正在使用此宏来从Excel工作表中提取相关信息到新工作表。但我似乎无法让它工作，这让我发疯。

你能找到错误或建议更好的approch吗？

编辑：我想对工作表列c中的数据进行排序，如果它与我的critera匹配（如果）我想将它与组（水果/浆果）匹配，并从adjecent列获取数据（P，I ，R）并将整个extraxt添加到新表（ws2）

Private Sub Extract_Click()

Dim ws1, ws2 As Worksheet
Dim i,k as Integer

set ws1 = Workbook.Activesheet

Set ws2 = Worksheets.Add(After:= _
      Worksheets(ThisWorkbook.Sheets.Count)) 
ws2.Name = "Extract" & ThisWorkbook.Sheets.Count 

With ws1

i = 10
k = 2  

    Do While Not Range("C" & i).Value = ""

            If Range("C" & i).Value = "Strawberry" Then

                ws1.Range("C" & i).Copy
                ws2.Range("A" & k).PasteSpecial Paste:=xlPasteValues

                ws2.Range("B" & k).Value = "Berry"

                ws1.Range("P" & i).Copy
                ws2.Range("C" & k).PasteSpecial Paste:=xlPasteValues

                ws1.Range("I" & i).Copy
                ws2.Range("D" & k).PasteSpecial Paste:=xlPasteValues

                ws1.Range("R" & i).Copy
                ws2.Range("E" & k).PasteSpecial Paste:=xlPasteValues

            ElseIf Range("C" & i).Value = "banana" Then

                ws1.Range("C" & i).Copy
                ws2.Range("A" & k).PasteSpecial Paste:=xlPasteValues

                ws2.Range("B" & k).Value = "Fruit"

                ws1.Range("P" & i).Copy
                ws2.Range("C" & k).PasteSpecial Paste:=xlPasteValues

                ws1.Range("I" & i).Copy
                ws2.Range("D" & k).PasteSpecial Paste:=xlPasteValues

                ws1.Range("R" & i).Copy
                ws2.Range("E" & k).PasteSpecial Paste:=xlPasteValues

            End If

       k = k+1
   i = i +1 

Loop 

End With


End Sub

Answer 1

我建议首先使用For Loop，然后检查单元格值是否匹配：

For i = 2 to lastRow
If Cell(i, columnNumber).value = Cell(i, columnNumber).Value Then
  //Do Something

使用for / if条件的VBA while循环

1 个答案: