难题，帮忙修改一下， 以A列为所列数据为基础，汇总余额表的H-K列数据相应数据

jjmysjg

留下记号，回去下载

excel学习123

乐乐2006201505 发表于 2017-3-6 20:58
已经在原代码基础上做出来了，所以也凑个热闹，贻笑大方。不足之处，望各位老师批评指正，不胜感激。

能改一下吗？

excel学习123

excel学习123 发表于 2017-3-7 10:26
能改一下吗？

也加上边框和合并居中什么的  我试了试改不成

乐乐2006201505

excel学习123 发表于 2017-3-7 10:34
也加上边框和合并居中什么的  我试了试改不成

后边的要求完全是用褚老师代码，对我来说是个学习的机会，谢谢褚老师！
Sub lsc借鉴()
ActiveSheet.UsedRange.Offset(2, 1).ClearContents
Application.ScreenUpdating = False
Set Fso = CreateObject("scripting.filesystemobject")
Set ff = Fso.getfolder(ThisWorkbook.Path)
Set d = CreateObject("Scripting.Dictionary")
Dim arr As Variant
    For Each f In ff.Files
       If f.Name <> ThisWorkbook.Name Then
         Workbooks.Open f
            With ThisWorkbook.Sheets(1)
                If .Range("b3") = "" Then
                tc = 2
                Else
                tc = tc + 4
                End If
                '下面代码中的split用法学习褚老师的，谢谢！
                .Cells(2, tc) = Split(f.Name, ".")(0)
                '下面两句代码完全使用褚老师的，受益匪浅，在此感谢。
                .Cells(2, tc).Resize(1, 4).Merge
                .Cells(3, tc).Resize(1, 4) = Array("本期发" & vbLf & "生借方", "本期发" & vbLf & "生贷方", _
                "期末余" & vbLf & "额借方", "期末余" & vbLf & "额贷方")
                    '以下四句建立数组并将数组写入字典中
                    arr = .Range("a4:a" & .Range("a65536").End(3).Row)
                    For i = 1 To UBound(arr)
                        d(arr(i, 1)) = ""
                    Next
                    i4 = 0
                    crr = ActiveWorkbook.Sheets(1).Range("H2:K290")
                    For Each i1 In ActiveWorkbook.Sheets(1).Range("d2:d200")
                        '下面代码中trim函数是学习褚老师的，谢谢！
                        If d.exists(Trim(i1.Value)) Then
                            i2 = i1.Row
                            i3 = .[a:a].Find(Trim(i1.Value), lookat:=xlWhole).Row
                            ActiveWorkbook.Sheets(1).Range("H" & i2 & ":K" & i2).Copy .Cells(i3, tc)
                        End If
                        i4 = i4 + 1
                    Next
            End With
          ActiveWorkbook.Close False
       End If
    Next
    '下面八句代码是借鉴或完全使用褚老师的，受益匪浅，在此感谢。
    i2 = Range("a65536").End(3).Row - 1
    With Range("b2").Resize(i2, tc + 2)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Borders.LineStyle = xlContinuous
      .NumberFormatLocal = "0.00"
      .EntireColumn.AutoFit
    End With
Application.ScreenUpdating = True
End Sub