エクセルＶＢＡを教えてください。

質問

エクセルＶＢＡを教えてください。

エクセル初心者です。
仕事の都合で下記のようなマクロを作らないといけないのですが作り方がよくわかりません・・・。
宜しくお願い致します。

-----------------------------------------------

列Ａ 　　列Ｂ　　　列Ｃ 　　列Ｄ
1行目　　名前　　　金額 　　日時
2行目　　Ａさん　　100円　　12/1
3行目　　　　　　　200円　　12/2
4行目　　　　　　　300円　　12/3
5行目　　合計　　　600円
6行目　　Ｂさん　　100円　　12/1
7行目　　　　　　　200円　　12/2
8行目　　　　　　　300円　　12/3
8行目　　　　　　　400円　　12/4
9行目　　合計　　　1000円
10行目 　Ｃさん　　100円　　12/1
11行目 　　　　　　200円　　12/2
12行目 　合計　　　300円

のExcel表があります。
これを下記のように変更したいです。
列を１つ挿入し、追加した列に合計行までそれぞれの人の名前をペーストしたいです。

列Ａ 　　列Ｂ　　　列Ｃ 　　列Ｄ 　　列Ｅ
1行目　　名前　　　名前 　　金額 　　日時
2行目　　Ａさん　　Ａさん 　100円　　12/1
3行目　　　　　　　Ａさん 　200円　　12/2
4行目　　　　　　　Ａさん 　300円　　12/3
5行目　　合計　　　Ａさん 　600円　　　　　　←合計欄まで名前をコピーしたいです。
6行目　　Ｂさん　　Ｂさん 　100円　　12/1
7行目　　　　　　　Ｂさん 　200円　　12/2
8行目　　　　　　　Ｂさん 　300円　　12/3
8行目　　　　　　　Ｂさん 　400円　　12/4
9行目　　合計　　　Ｂさん 　1000円
10行目 　Ｃさん　　Ｃさん 　100円　　12/1
11行目 　　　　　　Ｃさん 　200円　　12/2
12行目 　合計　　　Ｃさん 　300円

回答No.4

merlionXX · ベストアンサー

No1です。

Sub TEST02()
Dim r As Long, i As Long
r = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row 'A列最終行取得
Columns("B:B").Insert Shift:=xlToRight 'B列前に列追加
For i = 2 To r '2～最終行まで
If Cells(i, "A") <> "" And Cells(i, "A") <> "合計" Then 'A列i行が空白や合計で無い場合
Set x = Cells(i, "A") 'そのセルをｘとする
End If
x.Copy Cells(i, "B") 'B列にｘを写す
Next '繰り返す
End Sub

ではどうですか？

お礼

回答ありがとうございます。
これで第二弾が完成することができました。
どうもありがとうございました。

ちなみに、
「If Cells(i, "A") <> "" And Cells(i, "A") <> "合計" Then」
の、所は
「If Cells(i, "A") <> "" And Cells(i, "A") <> "　合計" Then」
と、させていただきました。
やはりスペースが入っていたようです・・・。

回答No.7

Wendy02

こんばんは。

直接の回答ではありませんが、

Trim /VBA.Trim は、そんなに起用なことは出来ないと思います。
例えば、このようにしないと、スペース抜きの「合計」にはならないはずです。

VBAなら、
Dim ret As String
Const MYTEXT As String = "　合　計　"
ret = Replace(MYTEXT, " ", "", , , vbTextCompare)

(なお、エラーが出ないから余計なことかもしれませんが、Str は、数値型を文字にする関数名ですから、変数に使わないほうがよいですね。)

ワークシートなら、
=SUBSTITUTE(ASC(B2)," ","")

回答No.6

ham_kamo

No.2です。
> しかし、これだと列Ｃの合計行に「合計」という文字がペーストされます。
あれ、おかしいですね。質問文と同じ表で試してうまくいったのですが。他の回答者の仰る通り「合計」の前後に空白が入ってるかもしれませんね。一応、そのケースに対応しました。

Sub 名前をコピー()
　　Dim r As Range
　　Dim Name As String, Str As String
　　Range("C:C").Insert Shift:=xlToRight
　　Range("C1").Value = "名前"
　　For Each r In Range("D2", Range("D65536").End(xlUp))
　　　　Str = Trim(r.Offset(0, -2).Value)
　　　　If Str <> "" And Str <> "合計" Then
　　　　　　　　Name = Str
　　　　End If
　　　　r.Offset(0, -1).Value = Name
　　Next
End Sub

お礼

回答ありがとうございます。
ご指摘通り「合計」の前に空白が入っていました・・・。
確認不足・説明不足で申し訳ございませんでした。

回答No.5

venzou

"合計"の前後にスペース等は入っていませんか？

例
"　合計"
"合計　"
"合　計"

回答No.3

venzou

マクロではないので必要ないかもしれませんが・・・

数式を使った回答

１　C列に新しい列を挿入する
２　C1に　名前　と入れる
３　C2に数式を入れる =IF(AND(TRIM(B2)<>"合計",TRIM(B2) <> ""),B2,C1)
４　C2をコピーしてC3以降に貼り付ける

５　C列全体をコピーする
６　「形式を指定して貼り付け」で値として貼り付ける
（５，６は必要なら実行してください）

回答No.2

ham_kamo

列Ａは「○行目」でいいのでしょうか？
一応、書かれた通りにマクロを書いてみました。
・列Ｃを挿入して１行目に「名前」を挿入
・その下Ｃ列にＢ列から取得した名前を挿入

Sub 名前をコピー()
　　Dim r As Range
　　Dim Name As String
　　Range("C:C").Insert Shift:=xlToRight
　　Range("C1").Value = "名前"
　　For Each r In Range("D2", Range("D65536").End(xlUp))
　　　　If r.Offset(0, -2).Value <> "" And r.Offset(0, -2) <> "合計" Then
　　　　　　　　Name = r.Offset(0, -2).Value
　　　　End If
　　　　r.Offset(0, -1).Value = Name
　　Next
End Sub

お礼

早速の回答ありがとうございます。
しかし、これだと列Ｃの合計行に「合計」という文字がペーストされます。
合計行にも「Ａさん」の名前をペーストするには
どのようにデバッグすればよろしいでしょうか？
お手数ですが、再びご教授宜しくお願い致します。

■現在のソースでは、↓のようになるのです。
列Ａ 　　列Ｂ　　　列Ｃ 　　列Ｄ 　　列Ｅ
1行目　　名前　　　名前 　　金額 　　日時
2行目　　Ａさん　　Ａさん 　100円　　12/1
3行目　　　　　　　Ａさん 　200円　　12/2
4行目　　　　　　　Ａさん 　300円　　12/3
5行目　　合計　　　合計 　　600円　　　　　←　列Ｃの合計行が「合計」となってしまいます。

■合計行にも「Ａさん」のように名前をペーストさせたいです。
列Ａ 　　列Ｂ　　　列Ｃ 　　列Ｄ 　　列Ｅ
1行目　　名前　　　名前 　　金額 　　日時
2行目　　Ａさん　　Ａさん 　100円　　12/1
3行目　　　　　　　Ａさん 　200円　　12/2
4行目　　　　　　　Ａさん 　300円　　12/3
5行目　　合計　　　Ａさん 　600円　　　　　←　列Ｃの合計行にも「Ａさん」と名前をペーストさせたいです。

回答No.1

merlionXX

http://odn.okwave.jp/qa2610484.html

これあなたじゃないんですか？

お礼

いえ、別の者です。
私も同じような状況でよく似たエクセルを作らないとならなくなったので、質問文を参考にさせていただきました。