ColA和ColC中的重复值

Question

有一个微小的错误，但我仍然不希望它出现。这是单个生成记录的屏幕截图。您可以在ColA中看到文件的路径，在B列中可以看到用户数据(姓名、姓氏、地址等)，而其他列(C、D、E、F等)则有特定的数据。现在，首先，我不知道为什么对许多行重复路径，这些行数等于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

@Variatus我感谢您的贡献，它帮助我理解了您使用的结构，但留下了，所以它给了我“下一个没有for”。但是，我已经纠正了，正如您所做的那样，修改了我的原始代码，所以只以这种方式转换代码的这一部分，现在它开始工作了。

    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

谢谢!

Answer 2

我重写了你的代码，可惜没有测试，因为我没有数据。我的工作重点是让您了解代码是如何多次复制值的。我请大家仔细阅读代码，并注意我的评论。我相信你将能够确定的点，我可能已经建议删除一些功能，你需要。恢复它们将很容易，因为我保留了大部分原始代码。

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