バラシシートと短冊シートがあり、(バラシシートのデーターは増減します)バラシシートのS列データーを短冊シートに記入していくようにしたいのですが、(短冊シートは罫線のテンプレートがつくってあります)1番から2,3,4とデーターを入れていきたいのですが、1つのボックスは1列10行の10個入るようになってますが、赤の矢印のように下から上に入れて行きます。ただし、記号が変われば次の行(ひとマス空ける)(上)に入るというようにしていきたいのです、そしてバラシシートのS列データーが空欄になれば1つのロットが終了となります。そこで、14のマスの様に飛ばしてまた、次のロットを15から始めるというようにしたいのですが、詳しい方よろしくお願い致します。
https://gyazo.com/cda42196eb85e970c419735ff4802140
No.5
- 回答日時:
No3です。
以下のマクロを標準モジュールに登録してください。
Option Explicit
Dim sh1 As Worksheet 'バラシシート
Dim sh2 As Worksheet '短冊シート
Public Sub 短冊シート設定2()
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
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 11 <> 0 Then
MsgBox ("マス番号の行が不正")
Exit Sub
End If
max_box = ((maxrow2 + 1) \ 11) * 6
'短冊シートのマスをクリア
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 <> 1 And pv <> sh1.Cells(wrow, "S").Value Then
seqNo = seqNo + 1
End If
If seqNo > 10 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 10
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 x As Long
Dim y As Long
y = (box_no - 1) \ 6
box_row = (y + 1) * 11 - seq_no
x = (box_no - 1) Mod 6
box_col = (x + 1) * 2
End Sub
No.4
- 回答日時:
No2です。
>DestinationRange.Interior.Color = SourceRange.Interior.Color
>このコードをどこに入れたらいいのか分かりません。
>申し訳ないですが、教えて下さい。
なんだか、意味も通じないようですね。
If v <> tmp Then nextitem
Nblock(Nitem).Value = v
Nblock(Nitem).Interior.Color = sht.Cells(rw, 19).Interior.Color '←この行を追加
nextitem
VBAが全くわからないようなら、あまり使用しない方が宜しいかと思います。
修正もできないし、変更もできないと何かあった時にお手上げになります。
ありがとうございます。
初心者を抜け出せないもので勉強中です、中々理解するのが難しいです。
お手数をおかけし申し訳ございません。
No.3ベストアンサー
- 回答日時:
補足要求です。
1.記号が変わった時の扱い
>ただし、記号が変われば次の行(ひとマス空ける)(上)に入るというようにしていきたいのです、
ということですが、記号が変わった時の、その記号の書き込み先が次のボックスの1個目の場合でも、その記号を2個目に書くのでしょうか。
それとも、1個目に書くのでしょうか。
例として、添付図のB1のセルは記号の変わり目なので、空欄ですが、もしここにFAシボがあり、
次の記号がFBブラックの場合、そのFBブラックは、(D10を空欄にして)D9へ出力するのか、それともD10へ出力するのかということです。
No1の方は、D9へ出力する方法を採用しているように見えます。
2.シート名について
バラシシートのシート名は、「バラシ」
短冊シートのシート名は、「短冊」
で良いですか。
No.2
- 回答日時:
No1です
>色も反映したいのですが、どうすればいいのでしょうか
色だけなら、値を記述する際に色もコピ―すれば良いでしょう。
文字色なら
DestinationRange.Font.Color = SourceRange.Font.Color
背景色なら
DestinationRange.Interior.Color = SourceRange.Interior.Color
といった感じです。
セルの値と書式を丸ごとコピペしてもよいのなら
SourceRange.Copy DestinationRange
の1行だけで全てコピペできます。
※ 似た様な質問を別になさっているようですが、記述するセルの順序が違うだけなので、まったく同じ仕組みのまま記述順序の制御部分を調整することで実現できると思います。
ありがとうございます。
DestinationRange.Interior.Color = SourceRange.Interior.Color
このコードをどこに入れたらいいのか分かりません。
申し訳ないですが、教えて下さい。
No.1
- 回答日時:
こんにちは
記入してゆく順序の制御さえできれば、あとは順に処理してゆけばよいだけですね。
説明が不十分なので、以下のように勝手に解釈しました。
>記号が変われば次の行(ひとマス空ける)(上)に入る~
一つのボックスの区切りと記号の変わり目が一致した場合に、次のボックスの最初の行を空欄にするのか否か不明ですが、文言通りに空欄を設けるものとしました。
>データーが空欄になれば1つのロットが終了となります。そこで、14のマスの様に飛ばして~
前のボックスが途中まで埋まっている場合に、次のボックスからスタートするのか、更に次のボックスからスタートする(=完全に空白のボックスを必ず一つ作る)のか不明ですが、後者として解釈しました。
また、ご提示の図ではセル位置が明確になっていませんけれど、短冊シートは1行目から(=B1:B10)からボックスが始まるものと仮定し、バラシシートのデータの対象はS列のみで2行目以降と仮定しています。
以下、ご参考までに。
(意図と異なっている部分は、適当に修正してください)
Dim Nblock As Range
Dim Nitem As Long
Sub Q12904594()
Dim sht As Worksheet
Dim rw As Long
Dim v As String, tmp As String
Set sht = Worksheets("Sheet1") '←バラシシート名
With Worksheets("Sheet2") '←短冊シート名
.Cells.ClearContents
Set Nblock = .Range("B1:B10")
Nitem = 10
Application.ScreenUpdating = False
For rw = 2 To sht.Cells(Rows.Count, 19).End(xlUp).Row
v = sht.Cells(rw, 19).Text
If tmp = "" Then tmp = v
If v = "" Then
If Nitem < 10 Then nextblock
nextblock
Else
If v <> tmp Then nextitem
Nblock(Nitem).Value = v
nextitem
End If
tmp = v
Next rw
Application.ScreenUpdating = True
End With
End Sub
Sub nextitem()
Nitem = Nitem - 1
If Nitem < 1 Then nextblock
End Sub
Sub nextblock()
Set Nblock = Nblock.Offset(, 2)
If Nblock(1).Column > 12 Then Set Nblock = Nblock.Offset(11, -12)
Nitem = 10
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルVBAで次の様にデーターをテンプレートに反映したいのですが、よろしくお願い致します。 1 2022/04/17 15:56
- 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(エクセル) Excel_マクロ_複数のシートのVLOOKUPで表示された#N/A以外に色付けをしたいです 1 2023/02/16 22:37
- Excel(エクセル) ある数値に対して、値を返す数式についてです 2 2022/09/13 22:06
- Excel(エクセル) エクセルのマクロでコピー後の貼り付け先を毎回指定したところにしたい 5 2022/08/12 10:47
- Visual Basic(VBA) VBAを使いシート間で貼り付け 3 2023/03/14 20:53
- Visual Basic(VBA) 【VBA】Excelで罫線を引きたい 3 2022/07/14 12:04
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
別のシートから値を取得するとき
-
同じ作業を複数のシートに実行...
-
VBA 存在しないシートを選...
-
ユーザーフォームに入力したデ...
-
実行時エラー'1004': WorkSheet...
-
ExcelのVBAのマクロで他のシー...
-
Excelマクロのエラーを解決した...
-
【ExcelVBA】全シートのセルの...
-
実行時エラー1004「Select メソ...
-
excelのマクロで該当処理できな...
-
エクセルのシート名変更で重複...
-
Excel チェックボックスにチェ...
-
VBAで指定シート以外の選択
-
特定の文字を含むシートだけマ...
-
Worksheet_Changeの内容を標準...
-
VBA 最終行まで数式をコピーする
-
IFステートの中にWithステート...
-
Excel VBA で自然対数の関数Ln...
-
エクセルVBA 変数への代入がう...
-
エクセルのマクロについて教え...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
別のシートから値を取得するとき
-
ユーザーフォームに入力したデ...
-
【ExcelVBA】全シートのセルの...
-
同じ作業を複数のシートに実行...
-
Excelマクロのエラーを解決した...
-
excelのマクロで該当処理できな...
-
XL:BeforeDoubleClickが動かない
-
ExcelVBA シート名を複数セルか...
-
実行時エラー'1004': WorkSheet...
-
VBA 存在しないシートを選...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
ブック名、シート名を他のモジ...
-
【Excel VBA】Worksheets().Act...
-
ExcelのVBAのマクロで他のシー...
-
エクセルのシート名変更で重複...
-
特定の文字を含むシートだけマ...
-
シートが保護されている状態で...
-
Excel マクロについての相談
-
VBA 検索して一致したセル...
おすすめ情報