7

したがって、これを広い範囲 (約 450k 行) で達成するために考えられる最善の方法は、次の Sue-do コードを使用することでした。

Range("A1").Copy ' A1 Contains Value I want to multiply column by
Range("MyTable[FooColumn]").PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply

これで機能しますが、値が変更されることはないため、その値をコピーして貼り付ける必要があるという事実は冗長に思えます。 

For Each c In Range("MyTable[MyColumnHeader]")
    If IsNumeric(c) And Not c = "" Then
        c.Value = c.Value * 453.592 ' The value that is in A1 from previos sample
    End If
Next

それは機能しますが、遅くなります。すべてのセルをループする必要があるためです。

私も試しました：

With Range("MyTable[MyColumnHeader]")
    .Value = .Value * 453.592
End With

ただし、列に複数の値がある場合、実行時エラー Type Mismatch Error を受け取りました。

"=R-1C * 453.592"列を挿入し、 Thenの FormulaR1C1 を使用することを考えました.Value = .Value。その後、列をシフトして上書きしますが、扱いにくいようで、貼り付けの乗算よりも遅くなると思います。

それで、誰かがこのタスクを達成するためのより良い方法を持っていますか?

4

4 に答える 4

14 
Sub Test()

    Dim rngData As Range

    Set rngData = ThisWorkbook.Worksheets("Sheet1").Range("A1:B10")
    rngData = Evaluate(rngData.Address & "*2")
End Sub

ちょっと時代遅れですが、それはあなたが探していたものですか？

于 2014-03-25T08:19:38.730 に答える
1

セルごとに更新しないでください。これは非常に遅く、VBA を使用するより良い方法があります。概要は次のとおりです。

  1. 処理に必要なすべての行/列に範囲を設定します
  2. VBAで値を配列にコピー
  3. 配列を処理する
  4. 1 回の操作で配列をワークシートに書き戻します

次に例を示します。

Public Sub FactorRange(ByRef r_first as Range, ByVal N_rows as Long, _
ByVal N_cols as Long, ByVal factor as Double)
    Dim r as Range
    'Set range from first cell and size
    Set r = f_first.Resize(N_rows,N_cols)
    Dim vals() as Variant
    ' Copy cell values into array
    vals = r.Value
    Dim i as Long, j as Long
    ' Do the math
    For i=1 to N_rows
      For j=1 to N_cols
        vals(i,j) = factor * vals(i,j)
      Next j
    Next i
    ' Write values back
    r.Value = vals
End Sub
于 2013-09-24T23:58:04.640 に答える
-1 
return_sheet = ActiveSheet.Name
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = "CopyPaste"
Selection.Value = 1
Selection.Copy
Sheets(return_sheet).Select 'if necessary select range you whant to multiply
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
    Application.DisplayAlerts = False
    Sheets("CopyPaste").Delete
    Application.DisplayAlerts = True
Sheets(return_sheet).Select
于 2015-04-17T09:34:50.623 に答える