跪求大神帮我修改一下代码

jjtxgt

我是新手，刚开始学VBA 求大神帮我修改一下

jjtxgt

Sub t() Dim i, j, d, dd, jj, wjm Set d = CreateObject("Scripting.Dictionary") Set dd = CreateObject("Scripting.Dictionary") For jj = 11 To 65 Step 3 wjm = Dir(ThisWorkbook.Path & "\*" & Format(Cells(1, jj), "mm-dd") & "*.*")  If wjm <> "" Then d.RemoveAll: dd.RemoveAll With GetObject(ThisWorkbook.Path & "\" & wjm) For i = 7 To .Sheets(1).[a65536].End(3).Row d(Val(.Sheets(1).Range("b" & i).Value)) = .Sheets(1).Range("d" & i) dd(Val(.Sheets(1).Range("b" & i).Value)) = Array(.Sheets(1).Range("g" & i).Value, .Sheets(1).Range("l" & i).Value, .Sheets(1).Range("o" & i).Value) Next i .Close False End With  For i = 3 To [a65536].End(3).Row If Range("c" & i) = "" Then Range("c" & i) = d(Range("b" & i).Value) Range(Cells(i, jj), Cells(i, jj + 2)) = dd(Range("b" & i).Value) Next i End If  Next End Sub

answer6141

Sub t()
Dim i, j, d, dd, jj, wjm

Set d = CreateObject("Scripting.Dictionary")

Set dd = CreateObject("Scripting.Dictionary")

For jj = 11 To 65 Step 3

    wjm = Dir(ThisWorkbook.Path & "\*" & Format(Cells(1, jj), "mm-dd") & "*.*")

    If wjm <> "" Then
        d.RemoveAll: dd.RemoveAll
        
        With GetObject(ThisWorkbook.Path & "\" & wjm)
        
            For i = 7 To .Sheets(1).[a65536].End(3).Row
                d(Val(.Sheets(1).Range("b" & i).Value)) = .Sheets(1).Range("d" & i)
                dd(Val(.Sheets(1).Range("b" & i).Value)) = Array(.Sheets(1).Range("g" & i).Value, .Sheets(1).Range("l" & i).Value, .Sheets(1).Range("o" & i).Value)
            Next i
            .Close False
        End With
   
        For i = 3 To [a65536].End(3).Row
            If Range("c" & i) = "" Then
                Range("c" & i) = d(Range("b" & i).Value)
                Range(Cells(i, jj), Cells(i, jj + 2)) = dd(Range("b" & i).Value)
            End If
        Next i
    End If

Next
End Sub

answer6141

answer6141 发表于 2019-12-16 22:49
Sub t()
Dim i, j, d, dd, jj, wjm

我也是新手，你的格式太乱了，而且没有注释，时间长了自己都忘了。不太清楚你要干嘛，就是改了下格式

abc123281

看你的代码太累   直接说明需求和你想要实现的效果

jjtxgt

abc123281 发表于 2019-12-16 22:55
看你的代码太累   直接说明需求和你想要实现的效果

不好意思哈。代码是我找人代写的

wodewan

不知道你报表的更新模式，猜测是要保留原先数据，若不是自己加个清空，附件供参考吧。