シート1のAセルに[商品名+番号]が入っていてBセルに値段が入っていて、
80行位並んでいます。
Aセル/Bセル
冷蔵庫1/50,000
冷蔵庫2/65,000
・・・
冷蔵庫8/73,000
洗濯機1/32,000
・・・
D1セル 冷蔵庫
D2セル 洗濯機
・・・
E1セル = =IF(D1="","",COUNTIF($A$1:$A$80,D1&"*"))
E2セル = =IF(D1="","",COUNTIF($A$1:$A$80,D2&"*"))
・・・
このリストを別シートに2列で表示したいのですが、
(1)左右どちらに表示されてもかまわないが、冷蔵庫は冷蔵庫でまとめて同じ列に表示する
(2)商品名や番号は追加されたり削除されたりするのでどの商品がいくつあるかはEセルで判断する
(3)左右ほぼ、同じ位の行になるように商品を振り分ける。
としたいのですが、どのようにしたらいいでしょうか?
マクロで構いませんので(他の方法は思いつかないです)アドバイス等でも結構ですので、教えてください。
何かわからない所があったら質問してください。
よろしくお願いします。
No.1
- 回答日時:
はじめまして。
私でよろしければ、サンプルマクロを作ってみたいと思います。
別シートに2列で表示させたいということですが、サンプルマクロが作りやすくなりますので、別シートの項目名と配置されるセル番地を決めていただけないでしょうか。
お手数をおかけいたしますが、よろしくお願いいたします。
この回答への補足
本当は、もっと複雑なので、それをここ載せたらかなり長くなってしまいます。
ですから、別シートの項目名は、
A、Dセルに商品名
B、Eセルに金額
Cセルは空白で、
1行目はタイトル
2行目は作った日付
3行目が項目見出し
4行目からデータの表示
という事でお願いします。
こんな、補足でよろしいでしょうか?
No.2
- 回答日時:
少し一般化しています。
A列に冷蔵庫、洗濯機のほかに約250品目以内なら対応します。
(1)A列にテストデータとしてSheet1のA1:A12にa,a,a,a,a,b,a,b,c,c,d,aといれます。
(2)VBEのModule1に下記コードを入れます。
Sub test01()
d = Worksheets("sheet1").Range("a1").CurrentRegion.Rows.Count
'---初期設定。第1行目分処理。
Cells(1, 10) = Cells(1, 1) 'J列 品名
Cells(1, 11) = 2 'K列 シートインデックス
Cells(1, 12) = 1 'L列 書きこみ済み行
Worksheets(2).Cells(1, 1) = Worksheets("sheet1").Cells(1, 1)
Worksheets(2).Cells(1, 2) = 1
m = 1
'-----第2行目以下
For i = 2 To d
For K = 1 To m
If Cells(i, 1) = Cells(K, 10) Then
Worksheets(Cells(K, 11)).Cells(Cells(K, 12) + 1, 1) = Worksheets("sheet1").Cells(i, 1)
Worksheets(Cells(K, 11)).Cells(Cells(K, 12) + 1, 2) = i
Cells(K, 12) = Cells(K, 12) + 1
GoTo p01
End If
Next K
'---新しい品目見つかった時
m = m + 1
Cells(m, 10) = Cells(i, 1)
Cells(m, 11) = Cells(m - 1, 11) + 1
Cells(m, 12) = 1
Worksheets(Cells(m, 11)).Cells(Cells(m, 12), 1) = Worksheets("sheet1").Cells(i, 1)
Worksheets(Cells(m, 11)).Cells(Cells(m, 12), 2) = i
'-----
p01:
Next i
End Sub
実行すると、Sheet2のA列のA1:A7に
aが7つ持ってきています。
Sheet3のA列のA1:A2にbが2つを持ってきています。
Sheet4、Sheet5以下説明省略。
(3)本番で修正すること
A.開始行が全て1からになっていますが、Cells(●,○)の●を修正してください。
B.シートのインデックス、記録済み行数をSheet1のJ,K,L行に持っていますが、邪魔な場合は適当な3列にずらし、関係行のCells(●,○)の○を修正してください
C.Sheet1のA列のデータしかSheet2以下に移していませんが、B、C・・列でSheet2以下に移す必要列
を、A列を移している直後に書き加えてください。
初期設定の部分と2行目以下の部分と2箇所あります。
D.上記でSheet2等のB列はSheet1の第何行
目から移したかを参考までにセットしています。省いて
下さい。
この回答への補足
回答ありがとうございます。
が、よくわかりません。
Sheet3やSheet4がでてくるのですが、1枚のシートへ2列に表示したいのです。
それと、わたしの例にどのように変更したらいいのかもちょっとわかりません。
お手数ですが、そのへんを教えて頂けないでしょうか?
No.3
- 回答日時:
#2の者です。
「冷蔵庫01」等から数字部分を取り除き比較しないといけないのが、洩れていました。下記にサブルーチンの一例を載せます。Cell(i,1)とJ列を
比較する時、変換後で比較してください。J列へのセット
も変換後の文字列でしてください。
Function suujidel(c As String)
a = "0123456789"
For i = 1 To Len(Cells(1, 1))
For j = 1 To 9
If Mid(c, i, 1) = Mid(a, j, 1) Then
b = Mid(c, 1, i - 1)
suujidel = b
Exit Function
End If
Next j
Next i
suujidel = c
End Function
'-------------
Sub test03()
Dim c As String
c = Cells(1, 1)
a = suujidel(c)
MsgBox a
End Sub
No.4
- 回答日時:
早速サンプルマクロを作ってみました。
Aセル/Bセル
冷蔵庫1/50,000
冷蔵庫2/65,000
・・・
冷蔵庫8/73,000
洗濯機1/32,000
・・・
このデータがシート1の4行目から入力されていることを想定しています。
D1セル 冷蔵庫
D2セル 洗濯機
・・・
このデータがシート1の2行目から入力されていることを想定しています。
書き出すデータはシート2の4行目から書き出されるように設定してあります。
Sub Test()
Dim i As Integer
Dim j As Integer
Dim myNum As Integer
For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row
For j = 4 To Cells(Rows.Count, 1).End(xlUp).Row
myNum = Application.WorksheetFunction.CountIf(Range("A" & j & ":" & "A" & j), Cells(i, 4).Value & "*")
If myNum = 1 Then
If j Mod 2 = 1 Then
If Worksheets(2).Range("A4").Value = "" Then
Worksheets(2).Range("A4").Value = Cells(j, 1).Value
Worksheets(2).Range("B4").Value = Cells(j, 2).Value
Else
Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(j, 1).Value
Worksheets(2).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Cells(j, 2).Value
End If
ElseIf j Mod 2 = 0 Then
If Worksheets(2).Range("D4").Value = "" Then
Worksheets(2).Range("D4").Value = Cells(j, 1).Value
Worksheets(2).Range("E4").Value = Cells(j, 2).Value
Else
Worksheets(2).Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = Cells(j, 1).Value
Worksheets(2).Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Value = Cells(j, 2).Value
End If
End If
End If
Next j
Next i
End Sub
あなた様は、VBAのことをご存知だと思いますので、このコードを実行してみてください。
左右のバランスは考えていませんが、左右にデータが振り分けられて移動するはずです。
左右のバランス調整につきましては、現在思考中です。出来上がり次第お知らせいたしますので、今しばらくお待ち下さい。
なお、実行方法がお解りにならない時はお知らせ下さい。説明させていただきます。
この回答への補足
回答ありがとうございます。
が、冷蔵庫は、冷蔵庫で1つの列にしたいのです。
この作業が3ヶ月に1回位あって、現在は
(1)まず、商品毎の個数を調べ(ここの部分は、D、Eセルに作りました)
(2)全てを足して2で割り、計算して左右に振り分けバランスよく配置し(この部分)
(3)罫線を引く(商品別に太線にし一行毎細線)
という作業をしています。
ですから、ちょうど半分という訳にはいかないと思うのですが、
出来るだけ、左右が同じ位になるようにしたいのです。
現在のサンプルデータとして、
冷蔵庫 8件、洗濯機 9件、電子レンジ 17件、扇風機 3件、エアコン 20件 パソコン 10件、ワープロ 13件
があります。
これを
冷蔵庫 8件/電子レンジ 17件
洗濯機 9件/扇風機 3件
パソコン 10件/エアコン 20件
ワープロ 13件
-----------------------------------
計 40件/ 40件
この例では、偶然、左右40件になっていますが、42件と38件位ならよしと思っています。
(それ以上はなるべくならないように・・・)
実際のデータは、(80件)固定ではありません。
もちろん、3ヵ月後には、追加されたり、削除されたりしますので今回の配置にはならなくなります。
ちょっと長くなってしまいましたが、よろしくお願いします。
No.5
- 回答日時:
左右のバランス調整を考えた修正マクロを作ってみました。
#4の想定と同じく作ってあります。Sub test()
Dim i As Integer
Dim j As Integer
Dim myNum As Integer
Dim myRow1 As Integer
Dim myRow2 As Integer
For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row
If i > 3 Then
myRow1 = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
myRow2 = Worksheets(2).Cells(Rows.Count, 4).End(xlUp).Row
End If
For j = 4 To Cells(Rows.Count, 1).End(xlUp).Row
myNum = Application.WorksheetFunction.CountIf(Range("A" & j & ":" & "A" & j), Cells(i, 4).Value & "*")
If myNum = 1 Then
If i = 2 Or (i <> 3 And myRow1 < myRow2) Or (i <> 3 And myRow1 = myRow2) Then
If Worksheets(2).Range("A4").Value = "" Then
Worksheets(2).Range("A4").Value = Cells(j, 1).Value
Worksheets(2).Range("B4").Value = Cells(j, 2).Value
Else
Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cells(j, 1).Value
Worksheets(2).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Cells(j, 2).Value
End If
ElseIf i = 3 Or myRow1 > myRow2 Then
If Worksheets(2).Range("D4").Value = "" Then
Worksheets(2).Range("D4").Value = Cells(j, 1).Value
Worksheets(2).Range("E4").Value = Cells(j, 2).Value
Else
Worksheets(2).Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = Cells(j, 1).Value
Worksheets(2).Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Value = Cells(j, 2).Value
End If
End If
End If
Next j
Next i
End Sub
あなた様のおやりになりたいことが、実現しているはずです。
もし不具合がありましたら、ご遠慮なくお知らせ下さい。
この回答への補足
No.4の補足を書いている間に、次の回答が入ってしまいました。
今、試してみたところ
No.4の補足に書いたサンプルデータが、
冷蔵庫 8件/洗濯機 9件
電子レンジ 17件/扇風機 3件
パソコン 10件/エアコン 20件
/ワープロ 13件
----------------------------------
計 35件/ 45件
でならんでいます。
実際には、半分に出来るので、出来ればNo.4に書いたようになって欲しいです。
無理でしたら、無理と書いて頂ければ諦めます。
よろしくお願いします。
このサンプルマクロはこれから勉強させて頂きます。
No.6ベストアンサー
- 回答日時:
なるべく左右の差が縮まるよう次のように考えてみました。
1.シート1のD列とE列を降順でソートをかける。(下のコードがこれを実行するマクロです。)
2.シート2のA列に一番データ量が多い商品を配置
3.シート2のD列に次にデータ量の多い商品を配置
4.シート2のD列に次にデータ量の多い商品を配置
5.シート2のA列に次にデータ量の多い商品を配置
6.4・5を繰り返す。
勿論例のように左右均等に振り分けられる時は必ず振り分けられるようにマクロを組むことは可能かと思いますが、今の私の知識ではこれが精一杯です。私の知識不足をお許し下さい。
あと、マクロで罫線を自動で引くこともできます。このマクロのコードが必要な時はお知らせ下さい。
このリストは優先順位が高い順に書いてあり上から順に振り分けたいので、
1のソートの部分はちょっと使えません。
が、おかげで振り分けのヒントが得られました。
これから、頑張って作ってみようと思います。
長いこと煩わせてしまい、大変すみませんでした。
どうもありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) excelで検索した商品の画像(ネットワーク上の)を表示させたい。 3 2023/06/28 00:32
- Visual Basic(VBA) ExcelのVBAコードについて教えて下さい。 2 2022/06/25 14:04
- Visual Basic(VBA) VBAコードで質問があります 2 2022/10/20 15:27
- Excel(エクセル) エクセルで、 A1セルに「A」という値、 B1セルに「B」という値が入っています。 どちらも表示形式 5 2023/02/22 23:05
- Excel(エクセル) エクセルの条件付き書式 個人シートを参照して集計シートに色付けしたい 1 2023/06/22 00:39
- Visual Basic(VBA) Excelのマクロについて教えてください。 3 2022/06/30 09:36
- Excel(エクセル) 表示形式、文字列セル(列)に数式を入力するには マクロ 1 2022/09/18 10:53
- Excel(エクセル) Excelについて A1からA12まで、1月〜12月と入力し、 B1からB12の範囲に、C1とD1に 4 2022/05/26 22:48
- Excel(エクセル) IFERROR、SMALL関数について 2 2022/08/22 23:40
- Excel(エクセル) ユーザー定義について質問です。 2 2023/06/28 13:21
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelでセルの値が同じか...
-
エクセルを使っていて2024/5/15...
-
【マクロ】必要な項目(列)の...
-
(マクロ)データをAブックからB...
-
エクセルVBA、別ブックへ転記す...
-
Microsoft 365の Excel を使用...
-
エクセル②
-
エクセルの暗号化なしのバーの...
-
エクセルの計算
-
指定文字の間に
-
Excelで縦軸の書式を0:00形式の...
-
エクセルで年休を管理する方法...
-
エクセル:一覧表に存在する文...
-
Excel
-
Googleスプレッドシートでファ...
-
エクセルでの作業計算方法について
-
UNIQUE関数が使えないバージョ...
-
エクセルで日付を数字+アルフ...
-
エクセル 白黒印刷で白線を印刷...
-
Excel ピボットテーブルで日付...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel 2019 のピボットテーブル...
-
[関数得意な方]教えて下さい・...
-
Excelにてある膨大なデータを管...
-
[関数について]わかる方教えて...
-
Excel初心者です。 詳しい方、...
-
excelの不要な行の削除ができな...
-
エクセル関数に詳しい方教えて...
-
INDIRECTを使わず excelで複数...
-
[オートフィルタ]で抽出された...
-
エクセルの神よ、ご回答を! エ...
-
エクセル関数に詳しい方、教え...
-
各ページの1番上の表示について
-
Excelで写真のような表を作った...
-
エクセルで不等号記号(≠)が上に...
-
数学 Tan(θ)-1/Cos(θ)について...
-
Excel 2019 は、SPILL機能があ...
-
Excelで全角を半角にしたいので...
-
条件付き書式を教えてください
-
Excel フィルターを掛けた状態...
-
[オートフィルタ]の適用範囲の...
おすすめ情報