如何在excel vba中的特定工作表上循环遍历相同的列?

时间:2015-10-02 23:26:51

标签: excel vba excel-vba

您好StackOverflow社区:

我想在我的工作簿中的三个特定工作表上遍历同一列。我知道需要有类似于发布herehere的代码,但我似乎无法让它们工作而是收到错误'1004',“应用程序定义的或对象定义的错误“。

附加说明:我在声明后输入“For this Workbook.sheets中的每个ws”,并在“End Sub”之前的最后输入“Next”。我还在下面的代码中尝试了“r = 1”之后的处理代码并收到了相同的1004错误。我在循环代码之后用“下一步”尝试了它,它仍然只循环通过第一张表。

这是代码:

Sub MakeWordList()
Dim InputSheet As Worksheet
Dim WordListSheet As Worksheet
Dim PuncChars As Variant, x As Variant
Dim i As Long, r As Long
Dim txt As String
Dim wordCnt As Long
Dim AllWords As Range
Dim PC As PivotCache
Dim PT As PivotTable

    Application.ScreenUpdating = False
    Set InputSheet = ActiveSheet
    Set WordListSheet = Worksheets.Add(after:=Worksheets(Sheets.Count))
    WordListSheet.Range("A1") = "All Words"
    WordListSheet.Range("A1").Font.Bold = True
    InputSheet.Activate
    wordCnt = 2
    PuncChars = Array(".", ",", ";", ":", "'", "!", "#", _
        "$", "%", "&", "(", ")", " - ", "_", "--", "+", _
        "=", "~", "/", "\", "{", "}", "[", "]", """", "?", "*")
    r = 1


'   Loop until blank cell is encountered
    Do While Cells(r, 7) <> ""
'       covert to UPPERCASE
        txt = UCase(Cells(r, 7))
'       Remove punctuation
        For i = 0 To UBound(PuncChars)
            txt = Replace(txt, PuncChars(i), "")
        Next i
'       Remove excess spaces
        txt = WorksheetFunction.Trim(txt)
'       Extract the words
        x = Split(txt)
        For i = 0 To UBound(x)
            WordListSheet.Cells(wordCnt, 1) = x(i)
            wordCnt = wordCnt + 1
        Next i
    r = r + 1
    Loop

'   Create pivot table
    WordListSheet.Activate
    Set AllWords = Range("A1").CurrentRegion
    Set PC = ActiveWorkbook.PivotCaches.Add _
        (SourceType:=xlDatabase, _
        SourceData:=AllWords)
    Set PT = PC.CreatePivotTable _
        (TableDestination:=Range("C1"), _
        TableName:="PivotTable1")
    With PT
        .AddDataField .PivotFields("All Words")
        .PivotFields("All Words").Orientation = xlRowField
    End With

End Sub

有什么方法可以循环我的前三张纸或识别我想要循环的纸张?具体来说,我想循环前三张中的每一张的G列。

1 个答案:

答案 0 :(得分:0)

我会做这样的事情,但我没有机会对此进行测试,因此可能需要整理。

Dim lSheets(2)

lSheets(0) = "Sheet1"
lSheets(1) = "Sheet2"
lSheets(2) = "Sheet3"

    Application.ScreenUpdating = False

    Set WordListSheet = Worksheets.Add(after:=Worksheets(Sheets.Count))
    WordListSheet.Range("A1") = "All Words"
    WordListSheet.Range("A1").Font.Bold = True

For k = LBound(lSheets) To UBound(lSheets)
    Set InputSheet = Sheets(lSheets(k))

    InputSheet.Activate

'REST OF CODE'

    r = r + 1
    Loop

Next k


'   Create pivot table
    WordListSheet.Activate

'REST OF CODE'