先程のとよく似ていますが、複雑です。
バラシシートと短冊シートがあり、(バラシシートのデーターは増減します)バラシシートのS列データーを短冊シートに記入していくようにしたいのですが、(短冊シートは罫線のテンプレートがつくってあります)1番から2,3,4とデーターを入れていきたいのですが、1つのボックスは4列6行の24個入るようになってますが、赤の矢印のように左上から下に入れて行きます。ただし、記号が変われば次の行(下)に入るというようにしていきたいのです、そしてバラシシートのS列データーが空欄になれば1つのロットが終了となります。そこで、7のマスの様に飛ばしてまた、次のロットを8から始めるというようにしたいのですが、詳しい方よろしくお願い致します。
https://gyazo.com/1d54c5cbe862e7cc29cbec48711afcea
No.1ベストアンサー
- 回答日時:
>記号が変われば次の行(下)に入るというようにしていきたいのです、
記号が変わった時に、次の行になっていた場合は、1行空白を開けないで書き込むようにしています。
添付図の例では、C3,D3,E3がFAシボになっていた場合です。その場合は、1行開けずに、B4からFBブラックを書き込むようにしています。
以下のマクロを標準モジュールに登録してください。
Option Explicit
Dim sh1 As Worksheet 'バラシシート
Dim sh2 As Worksheet '短冊シート
Public Sub 短冊シート設定3()
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim max_box As Long
Dim i As Long
Dim wrow As Long
Dim boxNo As Long
Dim seqNo As Long
Dim box_row As Long
Dim box_col As Long
Dim pv As String
Dim y As Long
Set sh1 = Worksheets("バラシ")
Set sh2 = Worksheets("短冊")
maxrow1 = sh1.Cells(Rows.count, "S").End(xlUp).row 'S列の最大行取得
If maxrow1 < 2 Then Exit Sub
maxrow2 = sh2.Cells(Rows.count, "A").End(xlUp).row 'A列の最大行取得
If (maxrow2 + 1) Mod 7 <> 0 Then
MsgBox ("マス番号の行が不正")
Exit Sub
End If
max_box = ((maxrow2 + 1) \ 7) * 3
'短冊シートのマスをクリア
For i = 1 To max_box
Call clear_box(i)
Next
'バラシシートを処理
boxNo = 1
seqNo = 0
pv = ""
For wrow = 2 To maxrow1
If sh1.Cells(wrow, "S").Value = "" Then
If seqNo > 0 Then
boxNo = boxNo + 2
seqNo = 0
pv = ""
End If
Else
seqNo = seqNo + 1
If (seqNo Mod 4) <> 1 And pv <> sh1.Cells(wrow, "S").Value Then
y = (seqNo - 1) \ 4
seqNo = (y + 1) * 4 + 1
End If
If seqNo > 24 Then
boxNo = boxNo + 1
seqNo = 1
End If
'マス番号とマス内番号に対応する位置を取得
Call get_pos_in_box(boxNo, seqNo, box_row, box_col)
'該当位置へS列データを設定
sh2.Cells(box_row, box_col).Value = sh1.Cells(wrow, "S").Value
sh2.Cells(box_row, box_col).Interior.Color = sh1.Cells(wrow, "S").Interior.Color
pv = sh1.Cells(wrow, "S").Value
End If
Next
MsgBox ("完了")
End Sub
'指定マスクリア
Private Sub clear_box(ByVal box_no As Long)
Dim box_row As Long
Dim box_col As Long
Dim i As Long
For i = 1 To 24
Call get_pos_in_box(box_no, i, box_row, box_col)
sh2.Cells(box_row, box_col).ClearContents
sh2.Cells(box_row, box_col).Interior.Pattern = xlNone
Next
End Sub
'指定マス内の指定位置取得
Private Sub get_pos_in_box(ByVal box_no As Long, ByVal seq_no As Long, ByRef box_row As Long, ByRef box_col As Long)
Dim x1 As Long
Dim x2 As Long
Dim y1 As Long
Dim y2 As Long
y1 = (box_no - 1) \ 3
y2 = (seq_no - 1) \ 4
box_row = y1 * 7 + 1 + y2
x1 = (box_no - 1) Mod 3
x2 = (seq_no - 1) Mod 4
box_col = x1 * 5 + 2 + x2
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルVBAで次の様にデーターをテンプレートに反映したいのですが、よろし 5 2022/04/17 15:52
- Visual Basic(VBA) エクセルVBAで次の様にデーターをテンプレートに反映したいのですが 9 2022/04/06 18:04
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) VBAで質問ですが、皆さんはどの様に導き出しているのでしょうか? 6 2022/05/03 21:53
- Excel(エクセル) エクセル表作成についてお分かりになる方教えて下さい。 10項目程度のエクセルデーターを一件、一件、デ 9 2022/05/28 14:53
- Excel(エクセル) ある数値に対して、値を返す数式についてです 2 2022/09/13 22:06
- Excel(エクセル) Excel_マクロ_複数のシートのVLOOKUPで表示された#N/A以外に色付けをしたいです 1 2023/02/16 22:37
- その他(Microsoft Office) エクセルマクロ オートフィルターでで選択コピー 2 2022/04/18 11:05
- Visual Basic(VBA) 2つの条件に合うセルにデータを転記したい 4 2022/12/02 11:05
- Excel(エクセル) Excelについて 6 2023/03/03 16:19
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
別のシートから値を取得するとき
-
ユーザーフォームに入力したデ...
-
XL:BeforeDoubleClickが動かない
-
セルの値によって、シート見出...
-
【ExcelVBA】全シートのセルの...
-
【VBA】色のついたシート名を取得
-
エクセルのシート名変更で重複...
-
ブック名、シート名を他のモジ...
-
ExcelVBA シート名を複数セルか...
-
VBAでオブジェクト変数にsetし...
-
Worksheet_Changeの内容を標準...
-
同じ作業を複数のシートに実行...
-
VBAの天才来てください
-
特定の文字を含むシートだけマ...
-
実行時エラー'1004': WorkSheet...
-
別のシートを参照して計算する方法
-
【VBA】指定した検索条件に一致...
-
ExcelのVBAのマクロで他のシー...
-
【Excel VBA】Worksheets().Act...
-
excelのマクロで該当処理できな...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
別のシートから値を取得するとき
-
ユーザーフォームに入力したデ...
-
Excelマクロのエラーを解決した...
-
excelのマクロで該当処理できな...
-
同じ作業を複数のシートに実行...
-
ExcelVBA シート名を複数セルか...
-
【ExcelVBA】全シートのセルの...
-
Excel マクロについての相談
-
VBA 存在しないシートを選...
-
実行時エラー'1004': WorkSheet...
-
特定の文字を含むシートだけマ...
-
ExcelのVBAのマクロで他のシー...
-
ブック名、シート名を他のモジ...
-
XL:BeforeDoubleClickが動かない
-
VBA 複数の各シートに行を追加...
-
エクセルのシート名変更で重複...
-
【Excel VBA】Worksheets().Act...
-
シートが保護されている状態で...
-
Excel VBA 複数行を数の分だけ...
-
for 文の 繰り返し処理に使える...
おすすめ情報
短冊シートに色も反映したいです。