[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『集計表から納品書への転記』(丸の内)
VBAで集計表から納品書への転記をを試みているのですが、集計表の店名が重複しており、その店だけの納品書への転記方法が思い浮かびません。 sheet(納品書)はそのままプリントアウトを考えています。
sheet(集計表)
A B C 1 店名 品名 個数 2 東京果物店 みかんL 1000 3 東京果物店 みかんM 500 4 東京果物店 バナナL 3000 5 神奈川果物店 みかんL 400 6 神奈川果物店 みかんM 200 7 神奈川果物店 バナナL 600 8 千葉果物店 リンゴL 300 9 千葉果物店 みかんL 500 10 千葉果物店 バナナM 150
sheet(納品書1)
A B
1 納品書
2 東京果物店御中
3
4 品名 個数
5 みかんL 1000
3 みかんM 500
4 バナナL 3000
sheet(納品書2)
A B
1 納品書
2 神奈川果物店御中
3
4 品名 個数
5 みかんL 400
6 みかんM 200
7 バナナL 600
sheet(納品書3)
A B
1 納品書
2 千葉果物店御中
3
4 品名 個数
5 リンゴL 300
6 みかんL 500
7 バナナM 150
< 使用 Excel:Excel2016、使用 OS:Windows7 >
Dim c As Range, d As Range, sht As Worksheet For Each sht In ThisWorkbook.Worksheets If Left(sht.Name, 3) = "納品書" Then Application.DisplayAlerts = False: sht.Delete Next sht For Each c In Sheets("集計表").Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeConstants) If WorksheetFunction.CountIf(Sheets("集計表").Range("A2:A" & c.Row), c.Value) = 1 Then Sheets.Add before:=Sheets("集計表") With ActiveSheet .Name = "納品書" & ctr + 1: ctr = ctr + 1 .Range("A1").Value = "納品書" .Range("A2").Value = c.Value & "御中" .Range("A4").Value = "品名" .Range("B4").Value = "個数" For Each d In Sheets("集計表").Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeConstants) If c.Value = d.Value Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Array(d.Offset(, 1).Value, d.Offset(, 2).Value) End If Next d End With End If Next c End Sub (mm) 2017/12/04(月) 16:55
mmさん、つたないことを伺います。納品書に番号を付ける部分ですが、 With ActiveSheet .Name = "納品書" & ctr + 1: ctr = ctr + 1 のctrは変数でしょうか?Dim 宣言にctrの記述がなかったので ?と思いました。 (丸の内) 2017/12/06(水) 11:58
sheet("納品書3")の左端からのシート数え番号を検索するプローシージャを作ったのですが、エラーになりうまくいきません。 どなたかご教示下さいますか? サンプルでは数シートですが、実際は20シート以上あるため、該当するシートの数え番号を検索するのが大変です。
Sub test() Dim a As integer For a = 1 To Worksheets.Count If Worksheets(a) = "納品書3" Then MsgBox Worksheets(a).Count End If Next a
End Sub
(丸の内) 2017/12/06(水) 16:56
Sub test()
Dim a As Integer
For a = 1 To Worksheets.Count If Worksheets(a).Name = "納品書3" Then MsgBox a Next a
End Sub (bi) 2017/12/06(水) 17:02
Sub main()
Dim c As Range, d As Range, sht As Worksheet Dim bb, cc, dd, ctr As Integer
For Each sht In ThisWorkbook.Worksheets If Left(sht.Name, 3) = "納品書" Then Application.DisplayAlerts = False: sht.Delete Next sht For Each c In Sheets("集計表").Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeConstants) If WorksheetFunction.CountIf(Sheets("集計表").Range("A2:A" & c.Row), c.Value) = 1 Then Sheets.Add before:=Sheets("集計表") With ActiveSheet .Name = "納品書" & ctr + 1: ctr = ctr + 1 .Range("A1").Value = "納品書" .Range("A2").Value = c.Value & "御中" .Range("A4").Value = "品名" .Range("B4").Value = "個数" For Each d In Sheets("集計表").Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeConstants) If c.Value = d.Value Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Array(d.Offset(, 1).Value, d.Offset(, 2).Value) End If Next d End With End If Next c
For bb = 1 To Worksheets.Count If Worksheets(bb).Name = "請求" Then For dd = 1 To ctr Worksheets("請求").Copy after:=Worksheets(Worksheets.Count) ActiveSheet.Name = "請求" & cc + 1: cc = cc + 1 Next dd Else End If Next bb
End Sub
(丸の内) 2017/12/07(木) 11:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.