Question

我的vba项目有问题。我的工作簿有4张（草稿，cky，腼腆和bey），在表格“草稿我有我所有的数据，我想重组它们。”草稿“栏目”的列“G”包含值（cky，coy）并且bey）。我希望我的宏通过colums并复制具有相同值的所有单元格并将它们粘贴到从单元格（A2）开始的相应表格中，例如：我希望宏复制所有具有“cky”的数据“并将其粘贴在工作表”cky“中，从A2开始，依此类推/ 下面你可以看到我到目前为止做了什么：

    Sub MainPower()

Dim lmid As String
Dim srange, SelData, ExtBbFor As String
Dim lastrow As Long
Dim i, j, k As Integer

    lastrow = ActiveSheet.Range("B30000").End(xlUp).Row
    srange = "G1:G" & lastrow
    SelData = "A1:G" & lastrow



    For i = 1 To lastrow
        If InStr(1, LCase(Range("E" & i)), "bb") <> 0 Then
            Range("G" & i).Value = Mid(Range("E" & i), 4, 3)

            ElseIf Left(Range("E" & i), 1) = "H" Then
                Range("G" & i).Value = Mid(Range("E" & i), 7, 3)
            Else
                Range("G" & i).Value = Mid(Range("E" & i), 1, 3)
        End If
    Next i
'Sorting data
    Range("A1").AutoFilter
    Range(SelData).Sort key1:=Range(srange), order1:=xlAscending, Header:=xlYes

'Spreading to the appropriate sheets
    j = 1
    For i = 1 To lastrow


        If Range("G" & i).Value = "CKY" Then


            Sheets("CKY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value

            ElseIf Range("G" & i).Value = "BEY" Then

            Sheets("BEY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value

            ElseIf Range("G" & i).Value = "COY" Then

            Sheets("COY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value

        End If
        j = j + 1

    Next i


End Sub

谢谢你的帮助最好的问候

Answer 1

在For循环中使用此重构代码，它应该更适合您：

For i = 1 To lastrow

    Select Case Sheets("Draft").Range("G" & i).Value

        Case is = "CKY","COY","BEY"

            Dim wsPaste as Worksheet
            Set wsPaste = Sheets(Range("G"& i).Value)

            Dim lRowPaste as Long
            lRowPaste = wsPaste.Range("A" & .Rows.COunt).End(xlup).Offset(1).Row

            wsPaste.Range("A" & lRowPaste & ":E" & lRowPaste).Value = _
             Sheets("Draft").Range("C" & i & ":G" & i).Value

     End Select

Next i

如何在vba excel中初始化我的计数器

1 个答案: