0

以下の写真を参考にします。 ここに画像の説明を入力

FirstValue 列をその右側の 2 つの列に分割しようとしています。ただし、パラメーター列に基づいて列を分割したいと考えています。Parameterの値が奇数の場合、OtherValue1列だけに値をコピーしたい。Parameterの値が偶数の場合、OtherValue2列だけに値をコピーしたいです。フォーラムを読み、Excel の「テキストから列へ」機能を試した後、解決策が見つかりません。

VBAを使用してこれを実装する方法はありますか?

*注: ワークシートは実際には約 10,000 行の長さなので、速度も役立ちます。

編集:これが私がこれまでに持っているコードです。次のコード行でオブジェクト エラーが発生しています。.Cells(2, MF1Col).Formula = "=IF(MOD(paraformula,2)=1,WTRfor,"")"

    Dim rw As Worksheet
Dim secondCell, MF1Cell, MF2Cell, paraCell, MF1formula, MF2formula, paraformula, WTRfor As Range
Dim secondCol As Long, MF1Col As Long, MF2Col As Long, paraCol As Long
 Set rw = ActiveSheet

With rw

    Set secondCell = .Rows(1).Find("FirstValue”)

    ' Check if the column with “FirstValue” is found

    'Insert Two Columns after FirstValue
    If Not secondCell Is Nothing Then
        secondCol = secondCell.Column
        .Columns(secondCol + 1).EntireColumn.Insert
        .Columns(secondCol + 2).EntireColumn.Insert
        .Cells(1, secondCol + 1).Value = "OtherValue1"
        .Cells(1, secondCol + 2).Value = "OtherValue2"
        .Activate

    Set MF1Cell = .Rows(1).Find("OtherValue1")
    MF1Col = MF1Cell.Column
    Set MF2Cell = .Rows(1).Find("OtherValue2")
    MF2Col = MF2Cell.Column
    Set paraCell = .Rows(1).Find("Parameter")
    paraCol = paraCell.Column

    Set paraformula = Range(.Cells(2, paraCol).Address(RowAbsolute:=False, ColumnAbsolute:=False))
    Set MF1formula = Range(.Cells(2, MF1Col).Address(RowAbsolute:=False, ColumnAbsolute:=False))
    Set WTRfor = Range(.Cells(2, secondCol).Address(RowAbsolute:=False, ColumnAbsolute:=False))
    .Cells(2, MF1Col).Formula = "=IF(MOD(" & paraformula & ",2)=1," & WTRfor & ","""")"
    Range(.Cells(2, MF1Col).Address).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveSheet.Paste

    Set MF2formula = Range(.Cells(2, MF2Col).Address(RowAbsolute:=False, ColumnAbsolute:=False))
    .Cells(2, MF2Col).Formula = "=IF(MOD(" & paraformula & ",2)=0," & WTRfor & ","""")"
    Range(.Cells(2, MF2Col).Address).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveSheet.Paste   

End If
End With
4

3 に答える 3

3

C2で=IF(MOD(E2,2)=1,B2,"")
、D2で、=IF(MOD(E2,2)=0,B2,"")

これらをデータの最後までコピーします

同じフォーマット (Data,Col1,Col2,Parameter) を仮定しますが、相対アドレス指定を使用し
ます 列 1: =IF(MOD(OFFSET(C2,0,2),2)=1,OFFSET(C2,0,-1),"") C2 を現在のセルに置き換え ます 列 2: =IF(MOD(OFFSET(D2,0,1),2)=0,OFFSET(D2,0,-2),"") D2 を現在のセルに置き換えます

もう一度、コピーして貼り付けます-最初のものが正しいと、Excelは現在のセルの数式を調整します

于 2012-07-06T18:05:09.267 に答える
1

セル D2 の場合:

    =IF(MOD(E2,2),B2,"")

説明: 範囲 E2 が 2 で割り切れない場合は、B2 の値が表示されます。それ以外の場合は何も表示されません。

セル C2 の MOD の前後に「NOT」を挿入することで、これを逆にすることができます。

    =IF(NOT(MOD(E2,2)),B2,"")
于 2012-07-06T18:05:26.723 に答える
0

VBA:

Sub odd_even()

a = 1                                                           ' start row
b = 10                                                          ' end row
c = 1                                                           ' column with values inputs

For d = a To b                                                  ' FOR loop from start row to end row

    If ActiveSheet.Cells(d, c) Mod 2 Then                       'mod becomes high when value is odd
        ActiveSheet.Cells(d, c + 2) = ActiveSheet.Cells(d, c)   'odd value gets copied to the odd-column   ( two to the right of the values)
        ActiveSheet.Cells(d, c + 3) = ""                        'same row on even-column gets cleared
    Else:
        ActiveSheet.Cells(d, c + 3) = ActiveSheet.Cells(d, c)   'even value gets copied to the even-column ( three to the right of the values)
        ActiveSheet.Cells(d, c + 2) = ""                        'same row on odd-column gets cleared
    End If

Next d                                                          ' go to next row

End Sub
于 2012-10-05T10:29:32.893 に答える