● Excel VBAでの計算処理

質問

●　Excel VBAでの計算処理

超初心者です。いろいろ研究したのですが、よくわかりません。
ＶＢＡに詳しい方、是非をお教えください。VBAでやりたいことは以下のことです。

(1)あるブックのSheet1、Ａ列の項目の特定のキーワード（例えば”数量”）を検索条件にしてデータを検索し、その行の複数の列（例えばＡＡ列からＣＣ列）の数値データに－１を掛けて正の数をすべて負の数にする。
(2)上記(1)の結果を別のブックの”計算結果”というシートに抽出する。
(3)元のブックには”数量”のほかさまざまなキーワードが設定されたデータが混在しています。また、計算の対象となる列のはじまりと終わりは特定できる。しかし、もとのブックの行数（データ件数）は特定できないとします。

イメージとしては、
元のブックにあるデータ）
Ａ列　　Ｂ列　　Ｃ列　　・・・・・　ＡＡ列　・・・・　ＣＣ列
数量　　　　　　　　　　　　　　　　５０００　　　　　２３７６
数量　　　　　　　　　　　　　　　　１２３４　　　　　９９３２
金額　　　　　　　　　　　　　　　　３００００　　　　２０９９

結果が抽出されたブックのイメージ（結果は別のブックに抽出される）
Ａ列　　Ｂ列　　Ｃ列　　・・・・・　ＡＡ列　・・・・　ＣＣ列
数量　　　　　　　　　　　　　　　　－５０００　　　　　－２３７６
数量　　　　　　　　　　　　　　　　－１２３４　　　　　－９９３２

回答No.3

hige_082 · ベストアンサー

＃１です
＞ファイルのパスを指定しても結果はうまくいかなかったのです。
フルパスは必要ありません
あるブックと別ブックは開いてから実行してください
質問に無い処理は作成していません
あるブック、別ブック、例えばなど
伏せられてるものが多いので
こちらでは、これ以上どうしようもありませんよ

以上

お礼

hige_082様、質問を出したあと、思い至ってブックをオープンするコードを追加したところ、うまくいきました。ありがとうございました。

回答No.2

mitarashi

正統的な回答があったので、安心して興味本位のコードを投稿します。研究なさりたいそうなので...

'対象データが1番目のシート、2番目のシートの1行目にマスクデータ
'転写先がBook2.xls（開いている）の指定のシート
'マスクデータは、-1を掛けたい列のみ-1を入れ、他の列は空白にしておく
Ａ列　　Ｂ列　　Ｃ列　　・・・・・　ＡＡ列　・・・・　ＣＣ列
　　　　　　　　　　　　　　　　　　－１　　　　　　　－１
Sub test()
Dim c As Range, maskRow As Range, destRange As Range
Dim firstAddress As String

Application.ScreenUpdating = False
Set maskRow = ThisWorkbook.Worksheets(2).Rows(1)
Set destRange = Workbooks("Book2.xls").Worksheets("計算結果").Range("A1")
With ThisWorkbook.Worksheets(1).Range("$A:$A")
Set c = .Find("数量", LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.EntireRow.Copy destRange
maskRow.Copy
destRange.PasteSpecial Paste:=xlValue, Operation:=xlMultiply, SkipBlanks:=True, Transpose:=False
Set destRange = destRange.Offset(1, 0)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Application.DataEntryMode = False
Application.ScreenUpdating = True
End Sub

回答No.1

hige_082

Sub Macro1()
Dim i, j
Dim コピー元 As Worksheet
Dim コピー先 As Worksheet
Dim 検索値 As String

検索値 = "数量"
Set コピー元 = Workbooks("あるブック").Worksheets("sheet1")
Set コピー先 = Workbooks("別のブック").Worksheets("計算結果")
For i = 1 To コピー元.Cells(Rows.Count, 1).End(xlUp).Row
If コピー元.Cells(i, 1).Value = 検索値 Then
For j = 27 To 81
コピー元.Cells(i, j).Value = コピー元.Cells(i, 1).Value * -1
Next j
コピー元.Rows(i).Copy コピー先.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next i
Set コピー元 = Nothing
Set コピー先 = Nothing
End Sub

参考まで

お礼

hige_082様、さっそく回答をしてくださりありがとうございます。
実行してみたところ、Set コピー元 = Workbooks("あるブック").Worksheets("sheet1")のところで実行時エラー’９’、インデックスが有効範囲にないとメッセージが表示されてしまいました。
”あるブック”は適合に名前を変更してファイルを実在させ、”別のブック”についても同様です。エラーメッセージはファイルが実在しないということを云っているのだと思いますが、ファイルのパスを指定しても結果はうまくいかなかったのです。
どういう対処をすればいいでしょうか。たびたびお聞きして申し訳ありません。どうか、お教えいただけませんか。