[[20200513010032]]　『ループを複数の列で』（コッペリオンの姉妹）　ページの最後に飛ぶ

『ループを複数の列で』（コッペリオンの姉妹）

今晩は。ここで助けて頂いております。
現在

Sub 複数列のループ()

    Dim g As Long
    g = 2
    Do While Cells(g, 1) <> ""
    Cells(g, 30) = Abs(Cells(g, 1))
    Cells(g, 31) = Abs(Cells(g, 2))
    Cells(g, 32) = Abs(Cells(g, 3))
    Cells(g, 32) = Abs(Cells(g, 4))
    Cells(g, 33) = Abs(Cells(g, 5))
    Cells(g, 34) = Abs(Cells(g, 6))
    Cells(g, 35) = Abs(Cells(g, 7))
    g = g + 1
    Loop
End Sub

ある列の数値を他の列に絶対値に変えてコピーという事を
やっていますが恐らくとても効率が悪いのは間違いないと思っています。
これをコンパクトにする方法はありますでしょうか。

上のプロシージャでいうと行だけではなく
列も2行目が空白にならない限りその列は空白になるまで行をコピー
させたい、というのが理想なのですが…

周りに余計な数値がありxlDownなど使ってみましたが反映されてくれませんでした。
どなかたよろしくお願いします。
いつもご迷惑をおかけしますが。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 参考に

 Sub Test()
    Dim i As Long, j As Long
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        For j = 30 To 36
            Cells(i, j).Value = Abs(Cells(i, j - 29).Value)
        Next j
    Next i
 End Sub

（ピンク） 2020/05/13(水) 02:23

 >列も2行目が空白にならない限りその列は空白になるまで行をコピー

 Sub Test2()
    Dim i As Long, j As Long
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        For j = 1 To Cells(i, 1).End(xlToRight).Column
            Cells(i, j + 29).Value = Abs(Cells(i, j).Value)
        Next j
    Next i
 End Sub

（ピンク） 2020/05/13(水) 02:32

ピンク様
ご解答ありがとうございます。大変助かりました。

便乗して申し訳ないのですが

列も2行目が空白にならない限りその列は空白になるまで行をコピー
というのを同じ列の下の行に四捨五入を反映させるやり方を教えて頂けないでしょうか。

現在は

Sub とりあえず下にコピー()

    Range("G11").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("G121").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

というマクロを組んでいてG121から下の全てのセルにRound関数を入れて四捨五入してあるのですが
これをセルに数式を入れずにVBAでやれたらなぁと思っています。

G121には=if(G11="","",Round(G11,3)) H121にはif(H11="","",Round(H11,3))
G122には=if(G12="","",Round(G12,3)) H122にはif(H12="","",Round(H12,3))

現在は↑の様にで全てのセルに反映させています。。が効率がすごく悪いです。。
何度もすみません。
（コッペリオンの姉妹） 2020/05/13(水) 21:51

横からですが、

 初めにセル範囲を特定してから、
 セル範囲の値をいったん、【二次元配列】に格納し、
 メモリ上でAbs関数で計算して
 一気にセル範囲に書き戻す

というプロセスにすれば、１回ごとにセルに書き出すよりは時間が短縮できるとおもいますが、どうでしょうか？

    Sub 実験()
        Dim セル範囲 As Range
        Dim 二次元配列 As Variant
        Dim x As Long, y As Long

        Set セル範囲 = Range("A1:C6")
        二次元配列 = セル範囲.Value

        For x = LBound(二次元配列, 1) To UBound(二次元配列, 1)
            For y = LBound(二次元配列, 2) To UBound(二次元配列, 2)
                If 二次元配列(x, y) <> "" Then
                    If IsNumeric(二次元配列(x, y)) Then
                        二次元配列(x, y) = Abs(二次元配列(x, y))
                    End If
                End If
            Next y
        Next x

        セル範囲.Value = 二次元配列

    End Sub

（もこな２） 2020/05/14(木) 09:41

↑書き出す場所が違うんでしたね。失礼しました。
こちらで。

    Sub 実験()
        Dim セル範囲 As Range
        Dim 二次元配列 As Variant
        Dim x As Long, y As Long

        Set セル範囲 = Range("A1:C6")
        二次元配列 = セル範囲.Value

        For x = LBound(二次元配列, 1) To UBound(二次元配列, 1)
            For y = LBound(二次元配列, 2) To UBound(二次元配列, 2)
                If 二次元配列(x, y) <> "" Then
                    If IsNumeric(二次元配列(x, y)) Then
                        二次元配列(x, y) = Abs(二次元配列(x, y))
                    End If
                End If
            Next y
        Next x

        Range("E10").Resize(UBound(二次元配列, 1), UBound(二次元配列, 2)).Value = 二次元配列
    End Sub

（もこな２） 2020/05/14(木) 09:45

 四捨五入した値を転記するのなら
 Sub Test3()
    Dim i As Long, j As Long
    For i = 11 To Cells(11, "G").End(xlDown).Row
        For j = 7 To Cells(11, "G").End(xlToRight).Column
            With Cells(i, j)
                '四捨五入した値を転記
                .Offset(110).Value = WorksheetFunction.Round(.Value, 3)
            End With
        Next j
    Next i
 End Sub

 数式を転記

            With Cells(i, j)
                .Offset(110).FormulaR1C1 = "=ROUND(R[-110]C,3)"
            End With

（ピンク） 2020/05/14(木) 11:04

コメント返信：

[ 一覧(最新更新順) ]

[[20200513010032]] 『ループを複数の列で』（コッペリオンの姉妹） ページの最後に飛ぶ

[[20200513010032]]　『ループを複数の列で』（コッペリオンの姉妹）　ページの最後に飛ぶ