Как заставить мой код VBA проходить по всем листам в книге? - PullRequest
Новая
       1

Как заставить мой код VBA проходить по всем листам в книге?

1 голос
/ 28 марта 2019

В моей книге 5 рабочих листов (Таблица 1, Таблица 2, Таблица 3, Таблица 4 и Комбинированные). Основной лист - это тот, который я пытаюсь объединить с другими 4 и поместить данные в следующую пустую строку.

Я искал разные решения для кода в течение нескольких недель, но безрезультатно.

Когда я перехожу через макрос и использую цикл (do while, for и Each), он только циклически перебирает таблицу 1. Но я не могу заставить его пройтись по листам 2-4.

Я думаю, что знаю, где моя проблема, но в мои недели поиска в Google, я все еще не могу найти решение. Я думаю, что проблема находится на линии, где это читает "Листы (" Таблица 1 "). Выберите". Потому что код, кажется, работает, пока не достигнет этой строки. Тогда это «конечно» возвращается к таблице 1.

Это тестовая группа для гораздо более крупного проекта. Я должен извлечь информацию из 500 документов, которые все находятся в одной и той же позиции, но я должен заставить эти 4 работать в первую очередь.

'Я пробовал это: 

Dim iSheet As Object

For Each iSheet In ThisWorkbook.Sheets
    MsgBox iSheet.Name
    Next iSheet

'И я попробовал это: 

Dim useWorkSheet As Worksheet
Dim totalWorkSheet As Worksheet
Dim tableAsNumeric As Integer
Dim startingTable As Integer

'For Each Current In Worksheets
'Table Name = Table in Worksheets

startingTable = 1

Set totalWorkSheet = ActiveWorkbook.Sheets("Table 1")

For Each useWorkSheet In ActiveWorkbook.Worksheets
    tableAsNumeric = Val(useWorkSheet.Name)

    'If tableAsNumeric >= startingTable Then

'Do While I >= Worksheet("Table 1")
'I = I + 1

'Я также пробовал цикл for и столько других, сколько есть в сети ... Ничего не работает ...

Вот код, с которым мне нужна помощь: 

Sub TFRdataExtract()
'
' TFRdataExtract Macro
' Extract Data from Individual TFR files to the combined file.
'
' Keyboard Shortcut: Ctrl+e
'

Dim iSheet As Object

For Each iSheet In ThisWorkbook.Sheets
    MsgBox iSheet.Name

    Sheets("Table 1").Select
    Range("AB1").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-27], 7,100)"
    Range("AC1").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-24], 14,100)"
    Range("AD1").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-19],23,100)"
    Range("AE1").Select
    ActiveCell.FormulaR1C1 = "=MID(RC[-10],22,100)"
    Range("AF1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[1]C[-31], 23,100)"
    Range("AG1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[1]C[-16], 10,100)"
    Range("AH1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[1]C[-13],13,100)"
    Range("AI1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[2]C[-34],22,100)"
    Range("AJ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[2]C[-25],18,100)"
    Range("AK1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[2]C[-16],21,100)"
    Range("AL1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[3]C[-37],21,100)"
    Range("AM1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[3]C[-28],17, 100)"
    Range("AN1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[3]C[-21],34,100)"
    Range("AO1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[4]C[-40],28,100)"
    Range("AP1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[4]C[-35], 7,100)"
    Range("AQ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[4]C[-34],10,100)"
    Range("AR1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[4]C[-29],10,100)"
    Range("AS1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[4]C[-21],22,100)"
    Range("AT1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[5]C[-45],26,100)"
    Range("AU1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[6]C[-46],18,100)"
    Range("AV1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[6]C[-37],55,100)"
    Range("AW1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[7]C[-48],36,100)"
    Range("AX1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[7]C[-39],30,100)"
    Range("AY1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[7]C[-28],12,100)"
    Range("AZ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[8]C[-51],20,100)"
    Range("BA1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[8]C[-35],12,100)"
    Range("BB1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[8]C[-31],20,100)"
    Range("BC1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[9]C[-54],25,100)"
    Range("BD1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[9]C[-45],15,100)"
    Range("BE1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[9]C[-39],23,100)"
    Range("BF1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[10]C[-57],17,100)"
    Range("BG1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[10]C[-56],17,100)"
    Range("BH1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[10]C[-52],13,100)"
    Range("BI1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[10]C[-42],14,100)"
    Range("BJ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[10]C[-38],15,100)"
    Range("BK1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-62],11,100)"
    Range("BL1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-62],12,100)"
    Range("BM1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-59],10,100)"
    Range("BN1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-57], 7,100)"
    Range("BO1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-55],7,100)"
    Range("BP1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-55],11,100)"
    Range("BQ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-53],12,100)"
    Range("BR1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-50],8,100)"
    Range("BS1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[12]C[-47],12,100)"
    Range("BT1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-71],10,100)"
    Range("BU1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-71],20,100)"
    Range("BV1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-66],10,100)"
    Range("BW1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-63],10,100)"
    Range("BX1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-62],8,100)"
    Range("BY1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-61],7,100)"
    Range("BZ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-59],9,100)"
    Range("CA1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-57],10,100)"
    Range("CB1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[13]C[-55],13,100)"
    Range("CC1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-80],12,100)"
    Range("CD1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-80],13,100)"
    Range("CE1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("CE1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-77],15,100)"
    Range("CF1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-72],7,100)"
    Range("CG1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-71],13,100)"
    Range("CH1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-67],14,100)"
    Range("CI1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[14]C[-62],7,100)"
    Range("CJ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[15]C[-87],13,100)"
    Range("CK1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[15]C[-85],15,100)"
    Range("CL1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[15]C[-82],11,100)"
    Range("CM1").Select
    ActiveCell.FormulaR1C1 = "L16,11,100)"
    Range("CN1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[15]C[-73],15,100)"
    Range("CO1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[15]C[-68],8,100)"
    Range("CP1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[17]C[-93],19,100)"
    Range("CQ1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[17]C[-80],22,100)"
    Range("CR1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[18]C[-95],27,100)"
    Range("CS1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[18]C[-82],18,100)"
    Range("CT1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[19]C[-97],45,100)"
    Range("CU1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[19]C[-89],22,100)"
    Range("CV1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[19]C[-81],49,100)"
    Range("CW1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[20]C[-91],21,100)"
    Range("CX1").Select
    ActiveCell.FormulaR1C1 = "=MID(R[21]C[-101],16,100)"
    Range("CY1").Select
    ActiveCell.FormulaR1C1 = "=MID(22,27,100)"
    Range("CZ1").Select
    ActiveWindow.SmallScroll Down:=-3
    Range("CY1").Select
    ActiveWindow.SmallScroll ToRight:=-50
    Range("AB1:CY1").Select
    Range("CY1").Activate
    Selection.Copy
    Sheets("Combined").Select
    Rows("2:2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Next iSheet

End Sub

Мне нужно перебрать все 4 рабочих листа и вставить данные в комбинированный файл в следующую пустую строку.

Ответы [ 6 ]

0 голосов
/ 28 марта 2019

На мой взгляд, вам следует избегать .Выбрать .Попробуйте: 

Option Explicit

Sub test()

    Dim ws As Worksheet

    With ThisWorkbook

        For Each ws In .Worksheets

            If ws.Name = "Table 1" Then

                With ws

                    .Range("AB1").FormulaR1C1 = "=MID(RC[-27], 7,100)"
                    .Range("AC1").FormulaR1C1 = "=MID(RC[-24], 14,100)"
                    .Range("AD1").FormulaR1C1 = "=MID(RC[-19],23,100)"
                    .Range("AE1").FormulaR1C1 = "=MID(RC[-10],22,100)"
                    .Range("AF1").FormulaR1C1 = "=MID(R[1]C[-31], 23,100)"
                    '....... Add more formulas
                    .Range("AB1:CY1").Copy


                End With

                With .Worksheets("Combined").Range("A2")
                    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                End With

            End If

        Next ws

    End With

End Sub
0 голосов
/ 28 марта 2019

Попробуйте этот фрагмент кода.Я уже использую это в макросе.

Sub Combine()

' ensure you have placed the "combined" worksheet as the first sheet

'variable declaration
Dim J As Integer

'copying header row from second sheet
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=ThisWorkbook.Sheets("combined").Range("A1")



'copying data from other sheets
For J = 2 To 4
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=ThisWorkbook.Sheets("combined").Range("A65536")_
.End(xlUp) (2)
Next

ThisWorkbook.Worksheets("combined").Columns.AutoFit


End Sub
0 голосов
/ 28 марта 2019

Цикл на всех листах

Пример 

Option Explicit
Public Sub Example()
'   // Declare your Variables
    Dim Sht As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    '// loop on all sheets
    For Each Sht In Worksheets
        Debug.Print Sht.Name
        'Do something
    Next

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With

End Sub
0 голосов
/ 28 марта 2019

Возможно, это поможет.Прокомментировано, чтобы помочь понять, что происходит. 

'// Modify as desired, like to empty rows/columns.
Private Function GetRangeToCopy(zWorksheet As Worksheet) As Range
    Set GetRangeToCopy= zWorksheet.UsedRange
End Function


'// Modify to add spacing or whatnot.
Private Function GetDestinationRange(zDestinationWorksheet As Worksheet, zRowCount As Long, zColumnCount As Long) As Range
    Dim zReturnRange As Range
    Dim zNewRowIndex As Long

    Let zNewRowIndex = zDestinationWorksheet.UsedRange.End.Row + 3 '// Increase to add more rows between inserts.
    Set zReturnRange = zDestinationWorksheet.

    Set GetDestinationRange = zReturnRange
End Function


'// Copies a range to the destination range.
Private Sub CopyRange(zSourceRange As Range, zDestinationRange As Range)
    '// This is where copying styles and such would be done.
    '// We will just call copy for simplicity.

    '// Clear.
    Call zDestinationRange.Clear

    '// Copy.
    Call zSourceRange.Copy(zDestinationRange)
End Sub


'// Copy worksheets to a destination worksheet.
'// Destination worksheet can be a worksheet loaded into a different workbook altogether.
Public Sub CopyWorksheetsTo(zDestinationWorksheet As Worksheet, zClearDestinationWorksheet As Boolean = False _
zPopupCurrentWorksheet As Boolean = True)
    Dim zCurrentWorksheet As Worksheet
    Dim zCurrentWorksheet_Var As Variant
    Dim zRangeToCopy As Range
    Dim zDestinationRange As Range

    '// Clear destination.
    If (zClearDestinationWorksheet) Then
        Call zDestinationWorksheet.UsedRange.Clear
    End If

    '// Cycle through each worksheet in the workbook.
    ForEach zCurrentWorksheet_Var in Worksheets
        '// this allow us the Intellisense while coding.
        Set zCurrentWorksheet = zCurrentWorksheet_Var

        '// Make sure this isn't the destination worksheet.
        If (zCurrentWorksheet.Name <> zDestinationWorksheet.Name) Then
            '// Popup worksheet name.
            If (zPopupCurrentWorksheet) Then
                Call MsgBox(zCurrentWorksheet.Name)
            End If

            '// Get range to be copied.
            Set zRangeToCopy = GetRangeToCopy(zCurrentWorksheet)

            '// Get destination range.
            Set zDestinationRange = GetDestinationRange(zDestinationWorksheet)

            '// Copy range.
            Call CopyRange(zRangeToCopy, zDestinationRange)
        End If
    Next xCurrentWorksheet_Var
End Sub
0 голосов
/ 28 марта 2019

Это должно работать: 

Sub TFRdataExtract()

    Dim iSheet As Worksheet, rngCopy As Range

    For Each iSheet In ThisWorkbook.WorkSheets

        If iSheet.Name Like "Table*" Then

            With iSheet                                            '<< no need to activate!
                .Range("AB1").FormulaR1C1 = "=MID(RC[-27], 7,100)" '<< no need to select!
                .Range("AC1").FormulaR1C1 = "=MID(RC[-24], 14,100)"
                .Range("AD1").FormulaR1C1 = "=MID(RC[-19],23,100)"
                'etc etc


                Set rngCopy = .Range("AB1:CY1")
            End with

            'assign values directly
            With ThisWorkbook.Sheets("Combined").Range("A2")
                .Resize(rngCopy.Rows.Count, _
                        rngCopy.Columns.Count).Value = rngCopy.Value
            End with

        End If 'EDIT - added

    Next iSheet

End Sub
0 голосов
/ 28 марта 2019

попробуйте это: 

For sht = 1 To Sheets.Count
    Debug.Print sht
    'your code here
    Sheets(sht).Activate'or
    Sheets(Sheets(sht).Name).Activate
Next
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...