请教修改代码!

快人一步

如果把这段代码改为整个工作簿中所有工作表一起执行替换，即是执行完表1再执行表2直到执行完所有工作表，应该怎样改，谢谢！

• Sub test()
•     Dim i%, d, arr, brr()
•     Set d = CreateObject("scripting.dictionary")
•     With ActiveSheet
•         arr = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
•         ReDim brr(1 To UBound(arr), 1 To 1)
•         d(0) = "a": d(1) = "a": d(2) = "b": d(3) = "b"
•         For i = 1 To UBound(arr)
•             If d.Exists(arr(i, 1)) Then brr(i, 1) = d(arr(i, 1))
•         Next
•         .Range("B1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row).ClearContents
•         .[B1].Resize(UBound(brr), 1) = brr
•     End With
• End Sub
• 
  

hfwufanhf2006

之前就看见你发了一个类似的帖子，也是要全工作簿执行代码。但我一直就没看懂，什么叫全工作簿执行？代码的执行是与具体数据关联的，不同工作表的数据通常是不一样的，同一个代码也没法在不同的数据之间去执行；
偶然，确实会有所有的表的数据都是类似的情况，比如日出库表、日发货单、日产量表...每天一个表，每个表都是一样式的，要对所有表进行操作，就是再加个循环外壳：
for i=1 to worksheets.count     '循环所有的表
    ...你的代码放在这里
next i

快人一步

hfwufanhf2006 发表于 2020-6-19 14:39
之前就看见你发了一个类似的帖子，也是要全工作簿执行代码。但我一直就没看懂，什么叫全工作簿执行？代码的 ...

师傅我这代码是活动工作表中每续个都执行替换的，我的目标是一个工作簿中有N工作个工作表，一次执行替换完成。我想按你的方法改不成功，不会改。
另加一列到C列d(0) = "c": d(1) = "c": d(2) = "d": d(3) = "d" 应该怎样改，谢谢！如附件:

hfwufanhf2006

快人一步 发表于 2020-6-19 15:37
师傅我这代码是活动工作表中每续个都执行替换的，我的目标是一个工作簿中有N工作个工作表，一次执行替换 ...

看了好久才搞明白，主要是你那个字典用的让我很迷惑。改成下面的代码：
你字典被我注释掉了，我觉得用不上。字典用于不确定的多条件，你这只有固定的2-3个条件，直接 if 就行了；
其他的改动还有：
1) 循环表：  For m = 1 To Worksheets.Count
2）引用表： With Worksheets(m)
3）参数转数字： s = Val(arr(i, 1))
     这是为了防止文本和数字格式的混用，数字0和文本0外观看不出来差别；
4）brr数组扩展：ReDim brr(1 To UBound(arr), 1 To 2)
     你要填充b\c两列，所以扩展定义成2列；

    Dim i%, d, arr, brr()
'   Set d = CreateObject("scripting.dictionary")
'   d(0) = "a": d(1) = "a": d(2) = "b": d(3) = "b"

  For m = 1 To Worksheets.Count
      With Worksheets(m)
        arr = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        ReDim brr(1 To UBound(arr), 1 To 2)
        For i = 1 To UBound(arr)

'            If d.Exists(arr(i, 1)) Then brr(i, 1) = d(arr(i, 1))
            s = Val(arr(i, 1))
            If s = 0 Or s = 1 Then
                 brr(i, 1) = "a"
                 brr(i, 2) = "c"
            End If
            If s = 2 Or s = 3 Then
                 brr(i, 1) = "b"
                 brr(i, 2) = "d"
            End If

        Next

        .Range("B1:c" & .Cells(.Rows.Count, 2).End(xlUp).Row).ClearContents
        .[B1].Resize(UBound(brr), 2) = brr

    End With
  Next m

快人一步

hfwufanhf2006 发表于 2020-6-19 16:13
看了好久才搞明白，主要是你那个字典用的让我很迷惑。改成下面的代码：
你字典被我注释掉了，我觉得用不 ...

感谢师傅，可能我说不够清楚，把你会错意了，现我得帮你帮助现已搞好了，谢谢！改动下数据如附件


Sub test1()
    Dim i%, d, arr, brr()
    Set d = CreateObject("scripting.dictionary")
   For m = 1 To Worksheets.Count
With Worksheets(m)
        arr = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        ReDim brr(1 To UBound(arr), 1 To 1)
         d("张三") = "王五": d("张四") = "王五": d("张五") = "王五": d("张六") = "王五": d("张七") = "王七"
        For i = 1 To UBound(arr)
            If d.Exists(arr(i, 1)) Then brr(i, 1) = d(arr(i, 1))
        Next
        .Range("B1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row).ClearContents
        .[B1].Resize(UBound(brr), 1) = brr
        d("张三") = "王六": d("张四") = "王六": d("张五") = "王六": d("张六") = "王六": d("张七") = "王八"
        For i = 1 To UBound(arr)
            If d.Exists(arr(i, 1)) Then brr(i, 1) = d(arr(i, 1))
        Next
        .Range("c1:c" & .Cells(.Rows.Count, 2).End(xlUp).Row).ClearContents
        .[c1].Resize(UBound(brr), 1) = brr
    End With
    Next
End Sub