Повторное значение в ColA и ColC

Question

Существует тривиальная ошибка, но я все еще не хочу, чтобы она появилась. Это скриншот одной сгенерированной записи. Как вы можете видеть в ColA путь к файлу, в столбце B пользовательские данные (имя, фамилия, адрес и т. Д. c), в то время как для других столбцов (C, D, E, F и т. Д. * 1016) *) определенные данные. Теперь, во-первых, я не знаю, почему путь повторяется для числа строк, равного общему количеству строк, используемых для столбца B, и, прежде всего, я не знаю, почему данные столбца B также частично копируются в столбце C.

ie1

Вот код

Option Explicit

Sub MergeCode1()
    Dim BaseWks As Worksheet
    Dim rnum As Long
    Dim MySplit As Variant
    Dim Mybook As Workbook
    Dim src1 As Range, src2 As Range, src3 As Range, src4 As Range, src5 As Range, src6 As Range, src7 As Range, src8 As Range, src9 As Range, src10 As Range, src11 As Range
    Dim destrange As Range
    Dim Rcount As Long
    Dim f

    'Add a new workbook with one sheet
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    BaseWks.Range("A1").Font.Size = 36
    BaseWks.Range("A1").Value = "Please Wait"
    rnum = 3

    MyFiles = ""
    Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=0, _
                          FileFilterOption:=0, FileNameFilterStr:="")

    If MyFiles <> "" Then

        MySplit = Split(MyFiles, Chr(13))
        For Each f In MySplit

            Set Mybook = Workbooks.Open(f)
            Set src1 = Mybook.Worksheets(1).Range("C10:C14")
            Set src2 = Mybook.Worksheets(1).Range("A11:A11")
            Set src3 = Mybook.Worksheets(1).Range("A16:A16")
            Set src4 = Mybook.Worksheets(1).Range("C16:C16")
            Set src5 = Mybook.Worksheets(1).Range("D16:D16")
            Set src6 = Mybook.Worksheets(1).Range("E16:E16")
            Set src7 = Mybook.Worksheets(1).Range("D17:D17")
            Set src8 = Mybook.Worksheets(1).Range("E17:E17")
            Set src9 = Mybook.Worksheets(1).Range("D18:D18")
            Set src10 = Mybook.Worksheets(1).Range("D19:D19")
            Set src11 = Mybook.Worksheets(1).Range("D20:D20")
            'max # of rows to be added...
            Rcount = Application.Max(src1.Rows.Count, src2.Rows.Count, src3.Rows.Count, src4.Rows.Count, src5.Rows.Count, src6.Rows.Count, src7.Rows.Count, src8.Rows.Count, src9.Rows.Count, src10.Rows.Count, src11.Rows.Count)

            If rnum + Rcount >= BaseWks.Rows.Count Then
                MsgBox "Sorry there are not enough rows in the sheet"
                Mybook.Close savechanges:=False
                Exit For
            Else

                BaseWks.Cells(rnum, "A").Resize(Rcount).Value = f

                BaseWks.Cells(rnum, "B").Resize(src1.Rows.Count, _
                                                src1.Columns.Count).Value = src1.Value
                BaseWks.Cells(rnum, "B").Offset(0, src1.Columns.Count) _
                             .Resize(src1.Rows.Count, src1.Columns.Count).Value = src1.Value

                BaseWks.Cells(rnum, "C").Resize(src2.Rows.Count, _
                                                src2.Columns.Count).Value = src2.Value
                BaseWks.Cells(rnum, "C").Offset(0, src2.Columns.Count) _
                             .Resize(src2.Rows.Count, src2.Columns.Count).Value = src2.Value

                BaseWks.Cells(rnum, "D").Resize(src3.Rows.Count, _
                                                src3.Columns.Count).Value = src3.Value
                BaseWks.Cells(rnum, "D").Offset(0, src3.Columns.Count) _
                             .Resize(src3.Rows.Count, src3.Columns.Count).Value = src3.Value

                BaseWks.Cells(rnum, "E").Resize(src4.Rows.Count, _
                                                src4.Columns.Count).Value = src4.Value
                BaseWks.Cells(rnum, "E").Offset(0, src4.Columns.Count) _
                             .Resize(src4.Rows.Count, src4.Columns.Count).Value = src4.Value

                BaseWks.Cells(rnum, "F").Resize(src5.Rows.Count, _
                                                src5.Columns.Count).Value = src5.Value
                BaseWks.Cells(rnum, "F").Offset(0, src5.Columns.Count) _
                             .Resize(src5.Rows.Count, src5.Columns.Count).Value = src5.Value

                BaseWks.Cells(rnum, "G").Resize(src6.Rows.Count, _
                                                src6.Columns.Count).Value = src6.Value
                BaseWks.Cells(rnum, "G").Offset(0, src6.Columns.Count) _
                             .Resize(src6.Rows.Count, src6.Columns.Count).Value = src6.Value

                BaseWks.Cells(rnum, "H").Resize(src7.Rows.Count, _
                                                src7.Columns.Count).Value = src7.Value
                BaseWks.Cells(rnum, "H").Offset(0, src7.Columns.Count) _
                             .Resize(src7.Rows.Count, src7.Columns.Count).Value = src7.Value

                BaseWks.Cells(rnum, "I").Resize(src8.Rows.Count, _
                                                src8.Columns.Count).Value = src8.Value
                BaseWks.Cells(rnum, "I").Offset(0, src8.Columns.Count) _
                             .Resize(src8.Rows.Count, src8.Columns.Count).Value = src8.Value

                BaseWks.Cells(rnum, "J").Resize(src9.Rows.Count, _
                                                src9.Columns.Count).Value = src9.Value
                BaseWks.Cells(rnum, "J").Offset(0, src9.Columns.Count) _
                             .Resize(src9.Rows.Count, src9.Columns.Count).Value = src9.Value

                BaseWks.Cells(rnum, "K").Resize(src10.Rows.Count, _
                                                src10.Columns.Count).Value = src10.Value
                BaseWks.Cells(rnum, "K").Offset(0, src10.Columns.Count) _
                             .Resize(src10.Rows.Count, src10.Columns.Count).Value = src10.Value

                BaseWks.Cells(rnum, "L").Resize(src11.Rows.Count, _
                                                src11.Columns.Count).Value = src11.Value
                BaseWks.Cells(rnum, "L").Offset(0, src11.Columns.Count) _
                             .Resize(src11.Rows.Count, src11.Columns.Count).Value = src11.Value

                rnum = rnum + Rcount

            End If

            Mybook.Close savechanges:=False
        Next f
        BaseWks.Columns.AutoFit

    End If

    BaseWks.Range("A1").Value = "Ready"

End Sub

Спасибо

Answer 1

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

Sub MergeCode1()

    Dim MyBook As Workbook
    Dim BaseWks As Worksheet
    Dim Rnum As Long
    Dim MySplit As Variant
    Dim Src(1 To 11) As Range           ' src1 becomes Src(1) etc
    Dim DestRange As Range
    Dim Rcount As Long
    Dim f As Variant
    Dim MyFiles As String
    Dim Ranges() As String
    Dim i As Integer
    Dim Tmp As Variant

    'Add a new workbook with one sheet
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    BaseWks.Range("A1").Font.Size = 36
    BaseWks.Range("A1").Value = "Please Wait"

    MyFiles = ""
    Call GetFilesOnMacWithOrWithoutSubfolders( _
                          Level:=1, ExtChoice:=0, _
                          FileFilterOption:=0, _
                          FileNameFilterStr:="")
    ' not clear where MyFiles might get a value from
    If MyFiles <> "" Then
        MySplit = Split(MyFiles, Chr(13))
        Ranges = Split("C10:C14,A11,A16,C16,D16,E16,D17,E17,D18,D19,D20", ",")
        Rnum = 3
        For Each f In MySplit
            Set MyBook = Workbooks.Open(f)
            With MyBook.Worksheets(1)
                For i = LBound(Src) To UBound(Src)
                    Set Src(i) = .Range(Ranges(i - 1))
                    Rcount = Application.Max(Rcount, Src(i).Rows.Count)
                Next i
            End With

            If Rnum + Rcount >= BaseWks.Rows.Count Then
                MsgBox "Sorry there are not enough rows in the sheet"
                MyBook.Close SaveChanges:=False
                Exit For
            Else
                With BaseWks
                    ' this command fills several rows in columns A with f
                    '.Cells(Rnum, "A").Resize(Rcount).Value = f
                    .Cells(Rnum, "A").Value = f

                    .Cells(Rnum, "B").Resize(Src(1).Rows.Count, _
                                             Src(1).Columns.Count).Value = Src(1).Value
                    ' this command writes the same value as above to the next column:-
                    '.Cells(Rnum, "B").Offset(0, Src(1).Columns.Count) _
                    '             .Resize(Src(1).Rows.Count, Src(1).Columns.Count).Value = Src(1).Value

                    ' All ranges from Src(2) and up have a single row and single column
                    ' Therefore, in the following Resizing can be omitted and
                    ' .Offset(0, Src(2).Columns.Count) can be hard-coded as .Offset(0, 1)
                    '   which writes the same value to the next column.
'                    .Cells(Rnum, "C").Resize(Src(2).Rows.Count, _
'                                             Src(2).Columns.Count).Value = Src(2).Value
                    ' revised:-
                    .Cells(Rnum, "C").Value = Src(2).Value
                    ' The command below writes the same value as above to the next column:-
                    '.Cells(Rnum, "C").Offset(0, Src(2).Columns.Count) _
                    '             .Resize(Src(2).Rows.Count, Src(2).Columns.Count).Value = Src(2).Value
                    ' revised:-
                    '.Cells(Rnum, "C").Offset(0, 1).Value = Src(2).Value

'                    .Cells(Rnum, "D").Resize(Src(3).Rows.Count, _
'                                                    Src(3).Columns.Count).Value = Src(3).Value
                    ' The command below writes the same value as above to the next column:-
'                    .Cells(Rnum, "D").Offset(0, Src(3).Columns.Count) _
'                                 .Resize(Src(3).Rows.Count, Src(3).Columns.Count).Value = Src(3).Value

                    .Cells(Rnum, "E").Value = Src(4).Value
                    ' The command below writes the same value as above to the next column:-
                    '.Cells(Rnum, "E").Offset(0, Src(4).Columns.Count) _
                    '             .Resize(Src(4).Rows.Count, Src(4).Columns.Count).Value = Src(4).Value

                    .Cells(Rnum, "F").Value = Src(5).Value
                    ' The command below writes the same value as above to the next column:-
                    '.Cells(Rnum, "F").Offset(0, Src(5).Columns.Count) _
                    '             .Resize(Src(5).Rows.Count, Src(5).Columns.Count).Value = Src(5).Value

                    .Cells(Rnum, "G").Value = Src(6).Value
                    ' The command below writes the same value as above to the next column:-
                    '.Cells(Rnum, "G").Offset(0, Src(6).Columns.Count) _
                    '             .Resize(Src(6).Rows.Count, Src(6).Columns.Count).Value = Src(6).Value

                    .Cells(Rnum, "H").Value = Src(7).Value
                    ' The command below writes the same value as above to the next column:-
                    '.Cells(Rnum, "H").Offset(0, Src(7).Columns.Count) _
                    '             .Resize(Src(7).Rows.Count, Src(7).Columns.Count).Value = Src(7).Value

                    .Cells(Rnum, "I").Value = Src(8).Value
                    ' The command below writes the same value as above to the next column:-
                    '.Cells(Rnum, "I").Offset(0, Src(8).Columns.Count) _
                    '             .Resize(Src(8).Rows.Count, Src(8).Columns.Count).Value = Src(8).Value

                    .Cells(Rnum, "J").Value = Src(9).Value
                    ' The command below writes the same value as above to the next column:-
                    '.Cells(Rnum, "J").Offset(0, Src(9).Columns.Count) _
                    '            .Resize(Src(9).Rows.Count, Src(9).Columns.Count).Value = Src(9).Value

                    .Cells(Rnum, "K").Value = Src(10).Value
                    ' The command below writes the same value as above to the next column:-
                    '.Cells(Rnum, "K").Offset(0, Src(10).Columns.Count) _
                    '            .Resize(Src(10).Rows.Count, Src(10).Columns.Count).Value = Src(10).Value

                    .Cells(Rnum, "L").Value = Src(11).Value
                    ' The command below writes the same value as above to the next column:-
                    '.Cells(Rnum, "L").Offset(0, src(11).Columns.Count) _
                    '            .Resize(src(11).Rows.Count, src(11).Columns.Count).Value = src(11).Value
                End With
                Rnum = Rnum + Rcount
            End If

            MyBook.Close SaveChanges:=False
        Next f
        BaseWks.Columns.AutoFit
    End If
    BaseWks.Range("A1").Value = "Ready"
End Sub

Answer 2

@ Variatus Я благодарю вас за ваш вклад, он помог мне понять структуру, которую вы использовали, но оставил, так что это дает мне «следующий без для». Однако, как и вы, я исправил мой исходный код, изменив таким образом только эту часть кода, и теперь он работает.

    BaseWks.Cells(Rnum, "A").Value = f

    BaseWks.Cells(Rnum, "B").Resize(src1.Rows.Count, _
                                    src1.Columns.Count).Value = src1.Value
    'BaseWks.Cells(Rnum, "B").Offset(0, src1.Columns.Count) _
                 .Resize(src1.Rows.Count, src1.Columns.Count).Value = src1.Value

    BaseWks.Cells(Rnum, "C").Value = src2.Value

    BaseWks.Cells(Rnum, "D").Value = src3.Value
    'BaseWks.Cells(Rnum, "D").Offset(0, src3.Columns.Count) _
                 .Resize(src3.Rows.Count, src3.Columns.Count).Value = src3.Value

Спасибо!