Question

正如标题所说 - 此代码将在Sheet1，第一列中搜索某个单词;例如＆＃34;怀特＆＃34;并将所有匹配粘贴到工作表2上的设置行中。白色表示武术白色腰带，并将所有列为白色腰带的学生姓名粘贴到sheet2上的设置行号/页面中，但是我只能将30个名字粘贴到页面和几个月有超过30个白带，所以我需要它将前30个名称粘贴到设置行中，其余部分在下一页中，例如，从第30个白色腰带向下5行。

有数百名学生和23种不同的皮带级别总是会改变第1页上的行号，因此固定方法不起作用。请帮忙。

Sub ADULTClearAndPaste()

Dim lr As Long, lr2 As Long, r As Long
Set Sh1 = ThisWorkbook.Worksheets("ADULT members to cut & past")
Set Sh2 = ThisWorkbook.Worksheets("ADULT Sign On Sheet")

Sh1.Select

lr = Sh1.Cells(Rows.Count, "B").End(xlUp).Row
w = 7
For r = 2 To lr
If Range("I" & r).Value = "White" Then
    Sh2.Cells(w, 5).Value = Sh1.Cells(r, 2).Value
    Sh2.Cells(w, 6).Value = Sh1.Cells(r, 3).Value
    w = w + 1
End If

Next r

py = 79

For r = 2 To lr
If Range("I" & r).Value = "Pro Yellow" Then
    Sh2.Cells(py, 5).Value = Sh1.Cells(r, 2).Value
    Sh2.Cells(py, 6).Value = Sh1.Cells(r, 3).Value
    py = py + 1
End If

Next r
Sh2.Select

End Sub

Answer 1

看起来你会遇到几个问题。你将w和py定义为整数，但是你说你可以在每个类别中拥有大量的人，我假设这些数字会改变，所以你可以通过指定哪一行开始来解决问题。

这将允许您将23种皮带颜色作为阵列（将皮带（2）更改为皮带（23）并填充颜色）然后根据您拥有的数量格式化您的第二张纸基于第一页的每种颜色。

我假设你在前六行的第二张纸上有一个标题。您可能需要更新Header变量以准确引用该范围，因为这将插入分页符，然后在必要时重复复制该标题：

Sub ADULTClearAndPaste()
Dim Belts(2) As String
Belts(1) = "White"
Belts(2) = "Pro Yellow"

Dim NewRow As Long
Dim RowCounter As Long
Dim Item As Range
Dim Header As Range
Dim Sht1 As Worksheet
Dim Sht2 As Worksheet

Set Sht1 = ThisWorkbook.Worksheets("ADULT members to cut & past")
Set Sht2 = ThisWorkbook.Worksheets("ADULT Sign On Sheet")
'Specify Header Range
Set Header = Sht2.Range("A1:F6")

NewRow = 7
For i = 1 To UBound(Belts)
    'This creates a new header/page for the next belt color
    If NewRow <> 7 Then
        Sht2.Rows(NewRow).PageBreak = xlPageBreakManual
        Sht2.Range(Sht2.Cells((NewRow), 1), Sht2.Cells((NewRow + 5), 6)).Value = Header.Value
        NewRow = NewRow + 6
    End If

    'This will reference which color is being processed,
    'I put it in there for reference but I figured you would update it
    Sht2.Range("A" & NewRow).Value = Belts(i)
    RowCounter = 0

    For Each Item In Sht1.Range("I1:I" & Sht1.UsedRange.Rows.Count)

        If Item.Value = Belts(i) Then
            Sht2.Cells(NewRow, 5).Value = Item.Offset(0, 1).Value
            Sht2.Cells(NewRow, 6).Value = Item.Offset(0, 2).Value
            NewRow = NewRow + 1
            RowCounter = RowCounter + 1
            If RowCounter = 30 Then
                'When you hit 30 lines the counter resets and a new header is added
                Sht2.Rows(NewRow).PageBreak = xlPageBreakManual
                Sht2.Range(Sht2.Cells((NewRow), 1), Sht2.Cells((NewRow + 5), 6)).Value = Header.Value
                NewRow = NewRow + 6
                RowCounter = 0
            End If
        End If
    Next Item
Next i
Sht2.Select

End Sub

要在两个工作表中复制和粘贴的搜索功能，需要对粘贴的行数进行数量限制

1 个答案: