シート間のコピー
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 |
Sub Excute() Set w = Sheets("マスタ登録用") Dim hayStack As Range: Set hayStack = Sheets("品目マスタ").Range("D15:D8462") For r = 3 To 3592 If (r Mod 5) = 0 Then DoEvents productName = x(w.Cells(r, 1).Text) productNote = x(w.Cells(r, 4).Text) productItem = x(w.Cells(r, 5).Text) productKg = x(w.Cells(r, 24).Text) productLength = x(w.Cells(r, 25).Text) productWidth = x(w.Cells(r, 26).Text) productHeight = x(w.Cells(r, 27).Text) If productName <> "" Then Call Pour(hayStack, productName, productNote, productItem, productKg, productLength, productWidth, productHeight) Application.StatusBar = r Next r Application.StatusBar = False MsgBox "done" End Sub Function x(target) target = Replace(target, vbCrLf, "") target = Replace(target, vbCr, "") target = Replace(target, vbLf, "") x = target End Function Sub Pour(hayStack, productName, productNote, productItem, productKg, productLength, productWidth, productHeight) Set w = Sheets("品目マスタ") For Each c In hayStack If (c.Text = productName) Then w.Cells(c.Row, 187) = productNote If productItem <> "" Then t = "1" w.Cells(c.Row, 179) = t w.Cells(c.Row, 180) = productKg w.Cells(c.Row, 181) = productLength w.Cells(c.Row, 182) = productWidth w.Cells(c.Row, 183) = productHeight End If Next End Sub |