エクセルのマクロ（データの出力について）

質問

１２３４５６７８９１０・・・・　←　日付
田中　　　　１　１　　１　　　
中村　　　　　１　　１　　
鈴木　　　　１１１１１　　
　・
　・
　・

上のようになっている表を下記のように変換したいのですが、マクロがうまく書けません。

Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ　Ｊ　Ｋ　Ｌ　　Ｍ
　　１　　　２　　　３　　　４　　　５　　　６　　７　　←　日付
　　田中　　中村　　田中　　鈴木　　中村　　田中
　　鈴木　　鈴木　　鈴木　　　　　　鈴木

Sub test01()
d = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
r = Worksheets("Sheet1").Range("IV2").End(xlToLeft).Column

k = 4 '新規作成用の行ポインター
For j = 2 To r
For i = 3 To d

If Worksheets("Sheet1").Cells(i, j) = 1 Then
Worksheets("新規作成用").Cells(k, 2 * (j - 6)) = Worksheets("Sheet1").Cells(i, 2)
k = k + 1
End If
Next i
Next j
End Sub
ここまで書いていきづまってしまいました。どなたかご指南ください。

回答No.3

Wendy02 · ベストアンサー

こんにちは。

コード自体は慣れの問題ですから、慣れれば問題ないけれども、基本的なことは守ったほうがよいです。

変数は宣言したほうがよいですね。
Option Explicit　で、変数の宣言を強制させたほうが、覚えます。

また、Cells のプロパティは、.Value を入れてください。それによって大差はないのですが、Cells, Rangeオブジェクトのプロパティには、.Value, Value2, .Text プロパティがありますので、それぞれ、使い分けなくてはならないことがありますので、習慣化しておくほうがよいです。

rとd は、読み間違えそうですので、ちょっと換えました。なお、なるべく2バイト文字やローマ字はやめて英語を使うようにするというのが、本来のVBAの書法です。その理由は、あまり意味はないと思うのですが、そういわれているということです。
'-------------------------------------------

　　mRow = Sh1.Range("A65536").End(xlUp).Row
　　mCol = Sh1.Range("IV2").End(xlToLeft).Column

k = 4 '新規作成用の開始行
　　For j = 2 To mCol　'列
　　　　For i = 3 To mRow　'行
　　　　　　If Worksheets("Sheet1").Cells(i, j).Value = 1 Then
　　　　　　　　Worksheets("新規作成用").Cells(k, 2 * (j - 2) + 2).Value _
　　　　　　　　　= Worksheets("Sheet1").Cells(i, 1).Value

　　　　　　　　　'新規作成用の最初、B4から...Cells(k, 2 * (j - 2) + 2)
　　　　　　　　　'氏名のリスト..A列..Cells(i,1)
　　　　　　　　k = k + 1
　　　　　　End If
　　　　Next i
　　　　k = 4
　　Next j

'-------------------------------------------

お礼

５人の方に回答をいただき、皆様ありがとうございました。代表で、Wendy02様のお礼欄に書かせて頂きます。

昔、プログラムをいじったことがある程度なので、基本的な事項からまったく分かりません。基本的なことから教えて頂きありがとうございました。

回答No.5

cistronezk

すでに回答が出ていますが、Excel的な作業の流れとしては、
（１）各行の１を左端の名前で置き換える
（２）表を選択し、ジャンプ画面で空欄を選択し、編集ー削除で「上方向にシフト」で上へ詰める
をマクロにする方法もあります。

Sub Macro1()
Dim rowno As Integer, maxrow As Integer
'データ部を新規作成用シートへコピー
With Sheets("Sheet1")
.Range(.Range("B1"), .Range("B1").SpecialCells(xlLastCell)).Copy
End With
'以下、新規作成用シートでの作業
Sheets("新規作成用").Activate
'データ部を値貼り付け
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
maxrowno = Selection.Rows.Count
'「１」を左端の文字列で置換
For rowno = 2 To maxrowno
Range(rowno & ":" & rowno).Replace What:="1", _
Replacement:=Sheets("Sheet1").Cells(rowno, 1).Value, LookAt:=xlWhole
Next
'表中の空欄を選択
Range("A2").CurrentRegion.SpecialCells(xlCellTypeBlanks).Select
'空欄を削除して上方向に詰める
Selection.Delete Shift:=xlUp
End Sub

お礼

私のレベルが低すぎて、どの回答が一番参考になるかすら、なかなか判断できませんが、皆様からのアドバイスはすべて有効に活用させていただきます。ありがとうございました。

回答No.4

hige_082

VBAを続けていくなら、後々のことを考え、行単位（レコード単位）で処理をする方法が良いと思います
理由は割愛しますが続けていけば分ると思います
＞For j = 2 To r
＞For i = 3 To d
For i = 3 To d
For j = 2 To r

表で例を挙げるのはよいのですが、行列番号があるほうがより分りやすい
　　　　　　１２３４５６７８９１０・・・・　←　日付
田中　　　　１　１　　１　　　
中村　　　　　１　　１　　
鈴木　　　　１１１１１　　
　・
　・
　・
ではなく
　　Ａ　　　　　ＢＣＤＥＦＧＨＩＪＫ・・・・・
１　　　　　　　１２３４５６７８９１０・・・・　←　日付
２　田中　　　　１　１　　１　　　
３　中村　　　　　１　　１　　
４　鈴木　　　　１１１１１　　
　・
　・
　・
表とマクロを提示するなら、整合を取りましょう
＞For j = 2 To r
＞For i = 3 To d
を見ると名前はＡ列３行目から、データはＢ列３行目からと思うが
表を見ると名前はＡ列２行目から、データはＢ列２行目からに思える
また、
＞Worksheets("Sheet1").Cells(i, 2)
これを見ると、名前はＢ列にあることになる、どれが正しい？

＞Cells(k, 2 * (j - 6))
列の計算のところ、説明も無く2 * (j - 6)とされても
表を見ても、マクロを見ても矛盾している

Sheet1
　　Ａ　　　　　ＢＣＤＥＦＧＨＩＪＫ・・・・・
１　　　　　　　１２３４５６７８９１０・・・・　←　日付
２　田中　　　　１　１　　１　　　
３　中村　　　　　１　　１　　
４　鈴木　　　　１１１１１　　
を下の表のように書き出す
新規作成用
　　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ　Ｇ　Ｈ　Ｉ　Ｊ　Ｋ　Ｌ　　Ｍ
１　　　１　　　２　　　３　　　４　　　５　　　６　　７　　←　日付
２　　　田中　　中村　　田中　　鈴木　　中村　　田中
３　　　鈴木　　鈴木　　鈴木　　　　　　鈴木

で、説明します
１　2行目をB列(日付)、C列、D列・・・とAF列まで順に見ていく
２　セルが「1」の場合、そのセル(日付)に対する列番号から、新規作成用シートの列(日付)を求める
３　その求めた列の最終行に名前を入力する
４　１～３をA列の名前がなくなるまで繰り返す

最終行の求め方を理解しているのならば、新規作成用シートに書き込むのも日付(列)の最終行に書き込めばよいと思います

提示されているマクロをなるべく使用(修正)した
サンプルを提示しておきます
Sub test01()
Dim i As Long, j As Long, k As Long
For i = 2 To Worksheets("Sheet1").Range("A65536").End(xlUp).Row
For j = 2 To 32
If Worksheets("Sheet1").Cells(i, j) = 1 Then
k = Worksheets("新規作成用").Cells(Rows.Count, 2 * (j - 1)).End(xlUp).Offset(1).Row '新規作成用の行ポインター
Worksheets("新規作成用").Cells(k, 2 * (j - 1)) = Worksheets("Sheet1").Cells(i, 1).Value
End If
Next j
Next i
End Sub

回答No.2

noname#102340

＞2 * (j - 6)
j=2とかのときマイナスになるので明らかにおかしい。

＞Worksheets("Sheet1").Cells(i, 2)
Cells(i, 1)　では？

＞Next i
＞Next j
1列ずれるので
Next i
k = 4
Next j

回答No.1

rivoisu

よく見たわけではありませんが
K=4の記述場所間違っています
転記先の列の計算が間違っているように思います。

このコードは

以下の処理を一日から31日まで行う
日ごとに下に順に見ながら"1"があったら名前を転記する

大雑把に疑似コードを書くと

for 一日目から31日まで
　　for 2行目から最後の行まで
　　　　　　もし　そのセルが1だったら名前を（k行目,日にち目）セルに転記する
　　　　　　　　そのあとKを1増やす
　　Next
Next

日にち目のセルつまり転送先の列番号の計算
転送先が1日分が2列なので2 * (j - 6))という記述にしてますが
ここはたぶん2*ｊ-6 (6じゃないかもしれないけど定数）と記述すべきでしょう。

あとKは1日分処理するごとに初期化（K＝４）すべきですから
1個目のForの次の行に移動する

行き詰った時はステップ実行をしながら変数の値が自分の意図したようになっているか確認すると問題点が絞れます。