一次性根据编码更新的内容更新工作薄中多个工作表相同编码的描单价、描述与费率

wqhsz385919

新年好！

请帮忙看下，一次性根据编码更新的内容更新工作薄中多个工作表相同编码的单价、描述与费，表中有具体描述，谢谢！
一次性更新工作薄中多个工作表的物料单价、描述、费率.rar (14.82 KB, 下载次数: 21)

2017-1-30 09:48 上传

点击文件名下载附件

lsc900707

先手机占位，有时间再处理。

kzg2013

Sub update()
Dim k As Integer
Dim k1 As Integer
Dim k2 As Integer
Dim k3 As Integer
Dim k4 As Integer

For k = 1 To Sheets.Count
If Sheets(1).Name <> "òa&#184;üD&#194;μ&#196;&#196;úèY" Then
Sheets("òa&#184;üD&#194;μ&#196;&#196;úèY").Move before:=Sheets(1)
Exit For
End If
Next k

For k2 = 2 To Sheets.Count
    k3 = Sheets(k2).Range("a1048576").End(xlUp).Row
                 For k1 = 2 To Sheets(1).Range("a1048576").End(xlUp).Row
                 For k4 = 2 To k3
                 If Sheets(1).Cells(k1, 1) = Sheets(k2).Cells(k4, 1) Then
                 Sheets(k2).Cells(k4, 2) = Sheets(1).Cells(k1, 2)
                 Sheets(k2).Cells(k4, 3) = Sheets(1).Cells(k1, 3)
                 Sheets(k2).Cells(k4, 4) = Sheets(1).Cells(k1, 4)
                 End If
                 Next k4
                 Next k1

  Next k2
MsgBox "ok"
End Sub

kzg2013

kzg2013 发表于 2017-1-30 11:46
Sub update()
Dim k As Integer
Dim k1 As Integer

乱码是一个表的名称（“要更新的内容”）

lsc900707

Sub lsc()
    Dim i&, j&, arr, d, sht As Worksheet
    Set d = CreateObject("scripting.dictionary")
    With Sheets("要更新的内容")
        r = .Cells(Rows.Count, 1).End(3).Row
        arr = .Range("A1:d" & r)
        For i = 2 To UBound(arr)
            For Each sht In Worksheets
                If sht.Name <> "要更新的内容" Then
                    With sht
                        For j = 2 To .Cells(Rows.Count, 1).End(3).Row
                            If .Cells(j, 1) = arr(i, 1) Then
                                 .Range("A" & j).Resize(1, UBound(arr, 2)) = WorksheetFunction.Index(arr, i)
                            End If
                        Next
                    End With
                End If
            Next
        Next
    End With
End Sub

lsc900707

请查看附件内容是否正确

znsong

同样的问题。。。哎！！