请教一个关于EXCEL的VBA代码的问题

2024-12-16 06:58:04
推荐回答(4个)
回答1:

Sub 宏2()
'
' 宏2 宏
'
'复制标题行
    Range("A1:T1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("类别1.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("类别2.xlsx").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("工作簿1.xlsx").Activate
    s1 = 2
    s2 = 2
 For i = 2 To 65536
     rg = "T" & i
     If Range(rg).Text <> "" Then
  If Range(rg).Text = 1 Then  '类别为1
    rg = "A" & i & ":T" & i
    Range(rg).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("类别1.xlsx").Activate
    rg = "A" & s1
    Range(rg).Select
    ActiveSheet.Paste
    Windows("工作簿1.xlsx").Activate
    s1 = s1 + 1
 End If
 If Range(rg).Text = 2 Then '类别为2
    rg = "A" & i & ":T" & i
    Range(rg).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("类别2.xlsx").Activate
    rg = "A" & s2
    Range(rg).Select
    ActiveSheet.Paste
    Windows("工作簿1.xlsx").Activate
    s2 = s2 + 1
 End If
  If Range(rg).Text = 3 Then '类别为3
    rg = "A" & i & ":T" & i
    Range(rg).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    i = i - 1
 End If
 Else
  Exit For
 End If
Next
End Sub

在线交流,望采纳。工作薄名分别为:工作簿1,类别1,类别2。要求先打开。是xlsx格式的。

回答2:

好吧,我还是按你的附件做了一个,看附件。

Sub 分类别()

Dim W1Path, W1Row, W1Column

Dim O1(), O2(), oo1, oo2

W1Path = ThisWorkbook.Path

W1Row = Sheet1.UsedRange.Rows.Count

W1Column = Sheet1.UsedRange.Columns.Count

ReDim O1(1 To Application.WorksheetFunction.CountIf(Columns("T"), 1), 1 To W1Column - 1)

ReDim O2(1 To Application.WorksheetFunction.CountIf(Columns("T"), 2), 1 To W1Column - 1)

oo1 = 1: oo2 = 1

For i = 2 To W1Row

    If Sheet1.Cells(i, "T") = 3 Then

        Sheet1.Rows(i).Delete

        i = i - 1

    Else

        If Sheet1.Cells(i, "T") = 1 Then

            For y = 1 To W1Column - 1

                O1(oo1, y) = Sheet1.Cells(i, y)

            Next

            oo1 = oo1 + 1

        ElseIf Sheet1.Cells(i, "T") = 2 Then

            For y = 1 To W1Column - 1

                O2(oo2, y) = Sheet1.Cells(i, y)

            Next

            oo2 = oo2 + 1

        End If

    End If

Next

Dim owrow, arrs, arrss()

For z = 1 To 2

    Workbooks.Open W1Path & "\类别" & z

    Windows("类别" & z & ".xls").Activate

    owrow = Sheets("sheet1").UsedRange.Rows.Count

    If z = 1 Then

        arrs = oo1

        arrss() = O1()

    Else

        arrs = oo2

        arrss() = O2()

    End If

    For x = 1 To arrs - 1

        For y = 1 To W1Column - 1

            Cells(x + owrow, y) = arrss(x, y)

        Next

    Next

Next

End Sub


回答3:

假设 你的总表名字是商品  vba代码如下

Sub 分类()
Sheets("类别1").Cells.ClearContents
Sheets("类别2").Cells.ClearContents
Dim a As Range
b = 1
c = 1
e = Application.CountA(Range("a:a"))
For i = 1 To e
Set a = Range("t" & i)
If a = 1 Then
Rows(i).Select
Selection.Copy
Sheets("类别1").Select
Rows(b).Select
ActiveSheet.Paste
b = b + 1
Else
If a = 2 Then
Rows(i).Select
Selection.Copy
Sheets("类别2").Select
Rows(c).Select
ActiveSheet.Paste
c = c + 1
Else
If a = 3 Then
Rows(i).Select
Selection.Delete Shift:=xlUp
i = i - 1
End If
End If
End If
Sheets("商品").Select
Next
End Sub

不懂得 在HI我

回答4:

没能理解你移到是复制还是剪切过去,可否讲明白点?
sm100e@qq.com