エクセル2003マクロの機能追加

質問

Sub test()
Dim 行1 As Long, 最終行 As Long, 行2 As Long
Sheets("Sheet2").Cells.ClearContents
Sheets("Sheet1").Activate
最終行 = Range("C65536").End(xlUp).Row
行2 = 1
For 行1 = 1 To 最終行
Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value
If Range("A" & 行1).Font.Bold Then
Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1"
Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value
Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2"
行2 = 行2 + 1
End If
If Range("A" & 行1) = "" Then
行2 = 行2 - 1
Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1)
End If
行2 = 行2 + 1
Next 行1
End Sub

元データ
AAAA5　9601　　950
BBBB1　9660　　150
ASAS9　9654　　-50
AXCW5　9603　　1375

以下の用にマクロで変換する機能を追加したいのです

AAAA5　9601　　950
BBBB1-1　9660　　150
BBBB1-2　9660　　150
ASAS9　9654　　50
AXCW5　9603　　1375

宜しくおねがいします。

回答No.5

hige_082

よく分かりません
元データ
AAAA5　9601　　950
BBBB1　9660　　150
ASAS9　9654　　-50
AXCW5　9603　　1375

上を下にするだけのマクロです

AAAA5　9601　　950
BBBB1-1　9660　　150
BBBB1-2　9660　　150
ASAS9　9654　　50
AXCW5　9603　　1375

Sub test()
Dim 行1 As Long, 最終行 As Long
Sheets("Sheet2").Cells.ClearContents
Sheets("Sheet1").Activate
最終行 = Range("C65536").End(xlUp).Row
With Sheets("Sheet2")
For 行1 = 最終行 To 1 Step -1
.Cells(行1, 1).Resize(1, 3).Value = Range(Cells(行1, 1), Cells(行1, 3)).Value
If .Cells(行1, 3).Value < 0 Then
.Cells(行1, 3).Value = .Cells(行1, 3).Value * -1
End If
If .Cells(行1, 1).Value = "BBBB1" Then
.Rows(.Cells(行1, 1).Row).Insert Shift:=xlDown
.Cells(行1, 1).Resize(1, 3).Value = .Cells(行1 + 1, 1).Resize(1, 3).Value
.Cells(行1, 1).Value = .Cells(行1, 1).Value & "-1"
.Cells(行1 + 1, 1).Value = .Cells(行1 + 1, 1).Value & "-2"
End If
Next 行1
End With
End Sub

使えるところは使おうと思ったが、殆んど書き換えることになってしまいました

＞後Sheet1やSheet2でのデータの移動をなくしたいです
＞元データ範囲はA1～C400で変換後はD1～F400にできますか？
意味不明？？？？？？？
BBBB1で追加した分の行は増えますよね
最初の質問も中途半端なのに、条件増やされても？？？
もっと、質問を整理しないとぐちゃぐちゃですよ

回答No.4

Sinogi

サンプルコードで .valueを使っていながらわざわざ　.Font.BoldをIf判定に使用し、それを改善したいという。
またセル指定がR1C1形式とA1形式が混在しており、しかもそれぞれに変数を使用している。
これらから複数の人が作ったコードをMixして使用しているように思う。

サンプルコードを流用するのは悪いことではない。それなりにコードは実行できるので理解できているはずだがコードメンテできないのはなぜだろう？もう少しご自身で理解し、整理することをお勧めする。

回答は既出だがみなさんが指摘されているように質問文は意味不明。
質問者自身がどのように条件でデータ加工したいか明確なら必然的にIf分は記述できるはず。

ASAS9　9654　　-50

-50がC列に存在し　c列が負のとき正の値にしたいなら

If cells(行1,3).Value < 0 Then
Sheets("Sheet2").cells(行1,3) = cells(行1,3).Value*-1

でもできるが、これは質問者自身が提示したコードのIf分を変えているだけ。

何がわからないのか明確にすべきです。

回答No.3

nag0720

＃１です。

「BBBB1を見つけたら」ということであれば、単に条件式を
If Range("A" & 行1).Value = "BBBB1" Then
に変えるだけです。

ASAS9　9654　　-50
についても、
If Range("A" & 行1).Value = "ASAS9" Then
Sheets("Sheet2").Range("C" & 行1) = -Range("C" & 行1)
End If

のように条件を指定して、符号を反転すればいいのでは。

「そうする場合の条件は？」と聞いたのは、どういうときに-50を50に変えたいのかという意味です。つまり、
A列がASAS9のときなのか、
A列に関係なく3行めだけなのか、
C列がマイナスのときなのか、
C列が-50だけのときなのか、
C列が9654ときなのか、
というように、条件を明確にしないといろいろな考え方があります。
例だけを示されても、どの意味か分かりません。

お礼

有難うございます。何をどうしたいのか明確に質問、、、
マクロが無知の自分には、、、
Sub test()
Dim 行1 As Long, 最終行 As Long, 行2 As Long
Sheets("Sheet2").Cells.ClearContents
Sheets("Sheet1").Activate
最終行 = Range("C65536").End(xlUp).Row
行2 = 1
For 行1 = 1 To 最終行
Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value
Sheets("Sheet2").Cells(行2, 3).Value = Abs(Sheets("Sheet2").Cells(行2, 3).Value)

If Range("A" & 行1).Value = "ADB21" Then
Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1"
Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value
Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2"
行2 = 行2 + 1
End If
If Range("A" & 行1) = "" Then
行2 = 行2 - 1
Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1)
End If
行2 = 行2 + 1
Next 行1
End Sub

とイジて見ました
-50は解決です
しかし、、、これだとADB21のみの変換今後増える予定です
これはA行が対象です

後Sheet1やSheet2でのデータの移動をなくしたいです
元データ範囲はA1～C400で変換後はD1～F400にできますか？

回答No.2

imogasi

長い、質問者だけの課題密着の、我流のコードを載せて、読者や回答者に読み解かせ、それをどう内容的に修正したいのか、内容を言葉で説明もせず、質問するのは、困る。回答者に負担をかけすぎです。
内容を判っている方もおられるようだが、それに甘えず、
（１）データ実例
（２）掲出コードの処理内容を言葉も添えて（コメントなども）
（３）修正したい内容を言葉で
書いて質問されるよう希望します。

回答No.1

nag0720

BBBB1を２行にしたいということであれば、そのようなマクロになっていますよ。
ただし、
If Range("A" & 行1).Font.Bold Then
という条件なので、A2 のフォントがBold(太字)になっている必要がありますが。

あと、
ASAS9　9654　　-50
が
ASAS9　9654　　50
と、符号が変わってますが、これはわざと？　間違い？
わざとの場合、そうする場合の条件は？

補足

太字にしなくても出来るようにしたいのです
BBBB1を見つけたら勝手にBBBB-1　BBBB-2の二行になるように
用はフォントの検索ではなくBBBB1みたいな文字列の検索でなるようにしたいのです
ASAS9 5654　-50も　50にしたいのです

条件は元データを一切変更せずに　マクロで一括変換したいのです