Данные из нескольких таблиц начинают вводиться не в ту ячейку таблицы - PullRequest
0 голосов
/ 23 января 2020

впервые спрашиваю здесь. Я нашел хороший код VBA, чтобы скопировать одни и те же заданные c ячейки из нескольких рабочих листов в рабочие таблицы и фактически выполняет свою работу (я не помню, где я его основал изначально). Единственная небольшая проблема заключается в том, что он начинает вводить данные из ячейки A2, а я хотел бы, чтобы он начинался с ячейки A4.

Вот код:

Sub ListFB()
Sheets("Master").Range("A4").Value = "Sheet Name"
For I = 1 To ThisWorkbook.Worksheets.Count
If Sheets(I).Name <> "RiassuntoTEST" Then
    Sheets("Master").Cells(I, 1).Value = Sheets(I).Range("B2").Value
   Sheets("Master").Cells(I, 2).Value = Sheets(I).Range("C2").Value
   Sheets("Master").Cells(I, 3).Value = Sheets(I).Range("C10").Value
   Sheets("Master").Cells(I, 4).Value = Sheets(I).Range("C11").Value
   Sheets("Master").Cells(I, 5).Value = Sheets(I).Range("C15").Value
   Sheets("Master").Cells(I, 6).Value = Sheets(I).Range("C16").Value
   Sheets("Master").Cells(I, 7).Value = Sheets(I).Range("C20").Value
   Sheets("Master").Cells(I, 8).Value = Sheets(I).Range("C21").Value
   Sheets("Master").Cells(I, 9).Value = Sheets(I).Range("C25").Value
   Sheets("Master").Cells(I, 10).Value = Sheets(I).Range("C26").Value
   Sheets("Master").Cells(I, 11).Value = Sheets(I).Range("C29").Value
   Sheets("Master").Cells(I, 12).Value = Sheets(I).Range("C30").Value
   Sheets("Master").Cells(I, 13).Value = Sheets(I).Range("C33").Value
   Sheets("Master").Cells(I, 14).Value = Sheets(I).Range("C34").Value
    End If
Next I
End Sub

Что я думаю он берет значение B2 из листа I и копирует его в A2 главной таблицы, затем принимает C2 и копирует его в B2, пока все необходимые данные с этого листа не будут помещены в те же строки, затем перейдет на следующий лист и поместит данные в следующих строках. Как я уже говорил выше, я хотел бы, чтобы весь этот процесс начинался с А4, а не с А2.

Я довольно новичок в такого рода вещах, поэтому любые отзывы и помощь приветствуются. Кроме того, строка

Sheets("Master").Range("A4").Value = "Sheet Name"

Делает что-нибудь для моей цели?

Спасибо!

Ответы [ 2 ]

1 голос
/ 23 января 2020

Первый выпуск:

Sheets("RiassuntoTEST").Cells(I, 1).Value

Cells содержит то, что известно как ссылка R1C1. Значение Номер строки, Номер столбца. Поскольку эта строка I = 1 To ThisWorkbook.Worksheets.Count рассчитывает от 1 до количества имеющихся у вас рабочих листов, она начнет вставляться в строку 1, столбец 1, также известную как ячейка A1. Если вы хотите увеличить это значение до ячейки A4, вам нужно увеличить это значение на 3 следующим образом:

Sheets("RiassuntoTEST").Cells(I + 3, 1).Value

Это необходимо сделать в каждой строке.

Второй выпуск:

Кроме того, выполняет ли строка Sheets ("RiassuntoTEST"). Range ("A4"). Value = "Nome Foglio" вообще что-нибудь для моей цели?

Нет, как было сказано ранее, ваш код (сейчас) не начнет вставляться в ячейку A4, поэтому, как только второй блок начнет работать, он будет перезаписан.

0 голосов
/ 23 января 2020

Я переписал ваш код таким образом, чтобы вы могли внести все необходимые изменения - возможно, с небольшой помощью комментариев, которые я вставил между строками кода.

Option Explicit

Sub UpdateMaster()
    ' Variatus @STO 23 Jan 2020

    Dim Wb As Workbook
    Dim MasterWs As Worksheet
    Dim Ws As Worksheet
    Dim SourceCell() As String
    Dim Rt As Long                          ' target row
    Dim Ct As Long                          ' target column
    Dim i As Integer

    Set Wb = ThisWorkbook                   ' you might specify another workbook
    ' specify the Master worksheet here
    Set MasterWs = Wb.Worksheets("TEST")
    ' list all the source cells here
    SourceCell = Split("B2,C2,C10,C11,C15,C16,C20,C21,C25,C26,C29,C30,C33,C34", ",")
    Rt = 4                                  ' set first row to write to here

    With MasterWs
        ' keep contents in rows 1 to 3 (incl title)
        .Range(.Cells(Rt, 1), .Cells(.Rows.Count, "A").End(xlUp) _
                                     .Offset(0, UBound(SourceCell) + 1)) _
                                     .ClearContents
    End With

    Application.ScreenUpdating = False      ' speeds up execution
    For i = 1 To Wb.Worksheets.Count
        Set Ws = Wb.Worksheets(i)
        If Not Ws Is MasterWs Then
            For Ct = 0 To UBound(SourceCell)
                MasterWs.Cells(Rt + i - 1, Ct + 1) = Ws.Range(Trim(SourceCell(Ct))).Value
            Next Ct
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...