Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 7 Professional : Excel 2010)
範囲単位で足し算するには
投稿日時: 18/08/06 19:47:24
投稿者: ヒロヒコ

こんにちは。いつもお世話になります。
ファイルからファイルへのデータ転記を行うのに以下のような転記表(ワークシート上)を使っています(表は何百行にもなります。ループで1行ずつ読んで処理)。
 
転記元ファイル/転記元シート/転記元セル範囲/転記先ファイル/転記先シート/転記先セル範囲
book1.xlsx/Sheet1/A1:A10/book2.xlsx/Sheet2/C11:C20
 
コードは以下のように書いています。
With ThisWorkbook.Worksheets("転記表")
    Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value = _
        Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(.Cells(lngR, 3).Value).Value
End With
 
単なる転記であればこれでいいのですが、例えばC11:C20に、A1:A10とB1:B10のそれぞれの和を入力したい場合、私が考えつくやり方は以下の5つでした。
1)ワークシート上に作業列を設ける。
 
2)範囲単位ではなく1行ずつやる(転記表の行数が相当増えてしまいます)
 
3)FormulaArrayを使う。
 例)転記表を −/−/'=[book1.xlsx]Sheet1!A1:A10+[book1.xlsx]Sheet1!B1:B10/book2.xlsx/Sheet2/C11:C20 として、コードは以下
 
With ThisWorkbook.Worksheets("転記表")
    Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).FormulaArray = _
        .Cells(lngR, 3).Value
End With
 
4)PasteSpecialでOperation:=xlAddにする
 例)転記表を
  book1.xlsx/Sheet1/A1:A10/book2.xlsx/Sheet2/C11:C20
  book1.xlsx/Sheet1/B1:B10/book2.xlsx/Sheet2/C11:C20
 としてコードは以下
 
With ThisWorkbook.Worksheets("転記表")
    Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(.Cells(lngR, 3).Value).Copy
 
    Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
End With
 
5)配列に読み込んでループで合計(コードが長くなる)
 
とりあえず4)のPasteSpecialでやる予定ですが、もし他にもっとスマートなやり方があればご教示いただけたらと思います。

回答
投稿日時: 18/08/08 00:54:28
投稿者: LMK

こんばんは
Evaluateメソッドで配列を使うのが一番速そうな気がします。
変則技かもしれませんが。

回答
投稿日時: 18/08/08 09:54:12
投稿者: TAKA君

ちょっとよく分からないので二種類書いてみます、、
見当違いだったらすみません
 
 

Sub ファイル開くとこは省略します()
    Dim 転記元 As Worksheet, 転記先 As Worksheet, i As Long
    SET 転記元 = ****
    SET 転記先 = ****
    ReDim Data(1 To 10, 1 To 3)
    For i = 1 To 10
        Data(i, 1) = 転記元.Cells(i, "A")
        Data(i, 2) = 転記元.Cells(i, "B")
        Data(i, 3) = 転記元.Cells(i, "A").Value + 転記元.Cells(i, "B")
    Next i
    転記先.Range("A1:C10") = Data
End Sub


 
Sub 合計だけ転記するならこっち()
    Dim 転記元 As Worksheet, 転記先 As Worksheet, i As Long
    SET 転記元 = ****
    SET 転記先 = ****
    ReDim Data(1 To 10, 1 To1)
    For i = 1 To 10
        Data(i, 3) = 転記元.Cells(i, "A").Value + 転記元.Cells(i, "B")
    Next i
    転記先.Range("C1:C10") = Data
End Sub

回答
投稿日時: 18/08/08 09:54:58
投稿者: TAKA君

TAKA君 さんの引用:
ちょっとよく分からないので二種類書いてみます、、
見当違いだったらすみません
 
 
Sub ファイル開くとこは省略します()
    Dim 転記元 As Worksheet, 転記先 As Worksheet, i As Long
    SET 転記元 = ****
    SET 転記先 = ****
    ReDim Data(1 To 10, 1 To 3)
    For i = 1 To 10
        Data(i, 1) = 転記元.Cells(i, "A")
        Data(i, 2) = 転記元.Cells(i, "B")
        Data(i, 3) = 転記元.Cells(i, "A").Value + 転記元.Cells(i, "B")
    Next i
    転記先.Range("A1:C10") = Data
End Sub


 
Sub 合計だけ転記するならこっち()
    Dim 転記元 As Worksheet, 転記先 As Worksheet, i As Long
    SET 転記元 = ****
    SET 転記先 = ****
    ReDim Data(1 To 10, 1 To1)
    For i = 1 To 10
        Data(i, 1) = 転記元.Cells(i, "A").Value + 転記元.Cells(i, "B")
    Next i
    転記先.Range("C1:C10") = Data
End Sub

回答
投稿日時: 18/08/08 09:57:08
投稿者: TAKA君

訂正しました、、これ消せないんですね。

回答
投稿日時: 18/08/08 10:43:57
投稿者: sk

引用:
ファイルからファイルへのデータ転記を行うのに
以下のような転記表(ワークシート上)を使っています

引用:
転記元ファイル/転記元シート/転記元セル範囲/転記先ファイル/転記先シート/転記先セル範囲
book1.xlsx/Sheet1/A1:A10/book2.xlsx/Sheet2/C11:C20

引用:
例えばC11:C20に、A1:A10とB1:B10のそれぞれの和を入力したい場合

[転記表]の[転記元セル範囲]の値として "A1:B10" のような
「 2 列以上のセル範囲を示すテキスト」が格納されている場合のことを
おっしゃっているのでしょうか。

投稿日時: 18/08/11 17:27:52
投稿者: ヒロヒコ

LMK さんの引用:
こんばんは
Evaluateメソッドで配列を使うのが一番速そうな気がします。
変則技かもしれませんが。

 
お返事遅くなりすみません。
 
LMKさん、ありがとうございます。Evaluateは配列使えるんですね。勉強になりました。
 
Workbooks("book2").Worksheets("Sheet1").Range("A1:A10").Value = Evaluate("[book1]Sheet1!A1:A10+[book1]Sheet1!B1:B10")

投稿日時: 18/08/11 17:34:40
投稿者: ヒロヒコ

TAKA君 さんの引用:
訂正しました、、これ消せないんですね。

 
TAKA君さん、ありがとうございます。普通はループでやればいいわけなんですが、今回、出来上がり品が私の手を離れてしまう(自分がいつまでメンテナンスできるかわからない)ため、できるだけワークシート上で表現して、VBAのコードは可能な限りシンプルにしたかったのです。
 
実際やるとしたらこんな感じでした。
 
Function fnc範囲同士の和(vnt1, vnt2)
 
Dim lngR As Long
Dim lngC As Long
Dim vnt3()
 
If UBound(vnt1, 1) <> UBound(vnt2, 1) Or UBound(vnt1, 2) <> UBound(vnt2, 2) Then
    MsgBox "範囲同士の行数もしくは列数が異なります"
    Exit Function
End If
 
ReDim vnt3(1 To UBound(vnt1, 1), 1 To UBound(vnt1, 2))
 
For lngC = 1 To UBound(vnt1, 2)
    For lngR = 1 To UBound(vnt1, 1)
        vnt3(lngR, lngC) = vnt1(lngR, lngC) + vnt2(lngR, lngC)
    Next
Next
 
fnc範囲同士の和 = vnt3
 
End Function

投稿日時: 18/08/11 17:54:26
投稿者: ヒロヒコ

sk さんの引用:
引用:
ファイルからファイルへのデータ転記を行うのに
以下のような転記表(ワークシート上)を使っています

引用:
転記元ファイル/転記元シート/転記元セル範囲/転記先ファイル/転記先シート/転記先セル範囲
book1.xlsx/Sheet1/A1:A10/book2.xlsx/Sheet2/C11:C20

引用:
例えばC11:C20に、A1:A10とB1:B10のそれぞれの和を入力したい場合

[転記表]の[転記元セル範囲]の値として "A1:B10" のような
「 2 列以上のセル範囲を示すテキスト」が格納されている場合のことを
おっしゃっているのでしょうか。

 
skさん、ありがとうございます。言葉足らずですみません。転記表の方はどんな表現でもいいんです。やりたいことが単なる転記だけでなく、A1+B1のように加算してから転記するケースもあるということです(作業列を作っておけば何の問題も無い話なのですが、シートの体裁を変えたくないという要望もあるもので)。
 
セル単位なら Range("A1").Value + Range("B1").Value とできるからいいのですが、それだと、例えばA1:A100とB1:B100の和なら転記表が100行分必要になってしまいます。
 
要するに Range("C11:C20").Value = Range("A1:A10").Value + Range("B1:B10").Value みたいにさくっと1行程度で書ける方法がどこかに無いのかなと思ったのでした。

回答
投稿日時: 18/08/13 11:22:05
投稿者: simple

> 要するに Range("C11:C20").Value = Range("A1:A10").Value + Range("B1:B10").Value
> みたいにさくっと1行程度で書ける方法がどこかに無いのかなと思ったのでした。

そうですね、行列指向の言語ではできるんですが、あいにくExcelはできませね。
 
すでに指摘のあった
・Evaluateを使う方法
・貴兄の Function fnc範囲同士の和(vnt1, vnt2)
などを使うことになるのでしょう。
 
例えば、
転記元ファイル/転記元シート/転記元セル範囲/転記先ファイル/転記先シート/転記先セル範囲
book1.xlsx/Sheet1/SUM(A1:A10,B1:B10)/book2.xlsx/Sheet2/C11:C20
などと書くルールを決めておいて、
転記元範囲を構文解析して、
(例:@単純なセル範囲の時、A頭にSUMがつけば、それぞれの和とみなす等)
fnc範囲同士の和(vnt1, vnt2)を使って値を求め、
結果を転記先セル範囲に書込む、といったことになるのでしょうか。
 
あとは折角いくつかの手法を提案されているので、
それぞれの所要時間なども書いていただくと大変有り難いですね。

投稿日時: 18/08/14 15:57:09
投稿者: ヒロヒコ

simpleさん、ありがとうございます。
10セル分の範囲2つを合計して別ファイルに転記×100回分の時間を計ってみました。(転記表の7列目に「加算」と書いてあれば合計する処理をすることにしました)
  
転記先ファイルの作業列に単に転記するだけであれば、200行の表で3回平均0.052秒でした。(Windows7、Excel2013、CPUはi7 4702MQ 2.20GHz)
  
転記表
 転記元ファイル/転記元シート/転記元セル範囲/転記先ファイル/転記先シート/転記先セル範囲/備考
book1.xlsx/Sheet1/A1:A10/book2.xlsx/Sheet2/A1:A10
 book1.xlsx/Sheet1/B1:B10/book2.xlsx/Sheet2/B1:B10
   
 

Sub prc単に転記() '作業列を使う

Dim lngR As Long
Dim lngStrt As Long
Dim lngEnd As Long

lngStrt = GetTickCount

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With ThisWorkbook.Worksheets("転記表1")
    For lngR = 2 To .Range("A1").CurrentRegion.Rows.Count
        Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value = _
            Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(.Cells(lngR, 3).Value).Value
    Next
End With
lngEnd = GetTickCount
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox (lngEnd - lngStrt) & "ミリ秒かかりました"

End Sub

   
範囲単位ではなく、セル単位でやると3回平均0.156秒でした。(転記表は1000行。以下、時間計測、描画停止、再計算のコードは省略)
  
転記表
 転記元ファイル/転記元シート/転記元セル範囲/転記先ファイル/転記先シート/転記先セル範囲/備考
book1.xlsx/Sheet1/A1,B1/book2.xlsx/Sheet2/AA1/加算
  
Sub prcセルごと合算して転記()

Dim lngR As Long

With ThisWorkbook.Worksheets("転記表2")
    For lngR = 2 To .Range("A1").CurrentRegion.Rows.Count
        Select Case .Cells(lngR, 7).Value
        Case "加算"
            Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value = _
                Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(Split(.Cells(lngR, 3).Value, ",")(0)).Value + _
                Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(Split(.Cells(lngR, 3).Value, ",")(1)).Value
        Case Else
            Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value = _
                Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(.Cells(lngR, 3).Value).Value
        End Select
    Next
End With
End Sub

   
 FomulaAllayを使うと平均0.078秒でした(転記表は100行)
 ※先ほど間違ったコードで投稿してたので訂正しました。
  
転記表
 転記元ファイル/転記元シート/転記元セル範囲/転記先ファイル/転記先シート/転記先セル範囲/備考
 −/−/=[book1.xlsx]Sheet1!A1:A10+[book1.xlsx]Sheet1!B1:B10/book2.xlsx/Sheet2/AA1:AA10/加算
  
Sub prcFomulaAllay()

Dim lngR As Long

With ThisWorkbook.Worksheets("転記表3")
    For lngR = 2 To .Range("A1").CurrentRegion.Rows.Count
        Select Case .Cells(lngR, 7).Value
        Case "加算"
             Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).FormulaArray = _
                .Cells(lngR, 3).Value
             Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value = _
                 Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value
        Case Else
            Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value = _
                Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(.Cells(lngR, 3).Value).Value
        End Select
    Next
End With

End Sub

   
 Evaluateを使うと平均0.083秒でした(転記表は100行)
  
転記表
 転記元ファイル/転記元シート/転記元セル範囲/転記先ファイル/転記先シート/転記先セル範囲/備考
 −/−/=[book1.xlsx]Sheet1!A1:A10+[book1.xlsx]Sheet1!B1:B10/book2.xlsx/Sheet2/AA1:AA10/加算
  
Sub prcEvaluate()

Dim lngR As Long

With ThisWorkbook.Worksheets("転記表3")
    For lngR = 2 To .Range("A1").CurrentRegion.Rows.Count
        Select Case .Cells(lngR, 7).Value
        Case "加算"
             Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).FormulaArray = _
                Evaluate(.Cells(lngR, 3).Value)
        Case Else
            Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value = _
                Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(.Cells(lngR, 3).Value).Value
        End Select
    Next
End With

End Sub

   
 PasteSpecialは21.877秒かかりました(転記表は200行)。さすがの遅さです。ただ、実際のケースでは範囲同士を加算して転記するのは何百行の転記のうちの数行だけなので、やはりこれでやろうと思います。
  
転記表
 転記元ファイル/転記元シート/転記元セル範囲/転記先ファイル/転記先シート/転記先セル範囲/備考
book1.xlsx/Sheet1/A1:A10/book2.xlsx/Sheet2/AA1:AA10/−
book1.xlsx/Sheet1/B1:B10/book2.xlsx/Sheet2/AA1:AA10/加算
  
Sub prcPasteSpecialで加算()

Dim lngR As Long

With ThisWorkbook.Worksheets("転記表4")
    For lngR = 2 To .Range("A1").CurrentRegion.Rows.Count
        Select Case .Cells(lngR, 7).Value
        Case "加算"
            Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(.Cells(lngR, 3).Value).Copy
            Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
        Case Else
            Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value = _
                Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(.Cells(lngR, 3).Value).Value
        End Select
    Next
End With

End Sub

  
サブルーチンにループで計算させるやり方では平均0.078秒でした(転記表は100行)。やはり普通はこれでやるのがいいと思います。
  
転記表
 転記元ファイル/転記元シート/転記元セル範囲/転記先ファイル/転記先シート/転記先セル範囲/備考
book1.xlsx/Sheet1/A1:A10,B1:B10/book2.xlsx/Sheet2/AA1:AA10/加算
  
Sub prcサブルーチンでループ()

Dim lngR As Long

With ThisWorkbook.Worksheets("転記表5")
    For lngR = 2 To .Range("A1").CurrentRegion.Rows.Count
        Select Case .Cells(lngR, 7).Value
        Case "加算"
            Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value = _
                fnc範囲同士の和(Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(Split(.Cells(lngR, 3).Value, ",")(0)).Value, _
                Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(Split(.Cells(lngR, 3).Value, ",")(1)).Value)
        Case Else
            Workbooks(.Cells(lngR, 4).Value).Worksheets(.Cells(lngR, 5).Value).Range(.Cells(lngR, 6).Value).Value = _
                Workbooks(.Cells(lngR, 1).Value).Worksheets(.Cells(lngR, 2).Value).Range(.Cells(lngR, 3).Value).Value
        End Select
    Next
End With

End Sub

 
   
長々とすみません。
  
もう少ししたら閉じようと思います。

回答
投稿日時: 18/08/14 23:32:31
投稿者: simple

テスト実験ありがとうございました。
 
もう少し閉じるのを待っていただくとありがたい。
たぶんコメントが寄せられそうな気がしますので。

回答
投稿日時: 18/08/15 23:16:49
投稿者: simple

私も同様に自分のデータで動かしてみました。
 
(1)A1:B1000値を、他のブックのA1:B1000に反映する処理を、100回繰り返す。
(2)A1:A1000とB1:B1000のセル毎の合計を、他のブックの C1:C1000に反映する処理を100回繰り返す。
 
以上をそれぞれ10回繰り返した平均が下記です。

                            実行時間(秒)    指数
(1)単に転記                     0.420       100%
(2a)FomulaArray                 0.425       101%
(2b)Evaluate                    0.234        56%
(2c)PasteSpecialで加算          1.842       438%
(2d)サブルーチンでループ        0.291        69%

これを見ると、
・予想されたように(2b)のEvaluateを使ったものが最速でしたが、
・(2d)prcサブルーチンでループ もさほど遜色ない結果でした。
・(2c)prcPasteSpecialで加算 も4倍程度ですから、実用には十分でしょう。
ということでしょうか。質問者さんのご指摘のとおりでしょう。
PasteSpecialの利用はそれほど段違いという感じでもないかな、という印象です。
 
少し待っていただいて、追加のコメントが無いようでしたら、
解決済みの処理をお願いしたいと思います。よろしくお願いします。

トピックに返信