Loop IF文を各列に入力

Question

アンケート結果をダウンロードしてExcelに入れました。

このマクロは "A"列に適用できます。

Private Sub CommandButton1_Click() 

counter = 2 'moves output 

For Each n In [A7:A50] 'loops through cell in specified range 

    If n < 400 Then 
     Sheets("Output").Cells(counter, "B") = 0 'Output to other sheet, = points awarded 
    ElseIf n > 400 Then 
     Sheets("Output").Cells(counter, "B") = 3 'Output to other seet, = points awarded 
    End If 

    counter = counter + 1 'moves counter up 1 

Next 

End Sub 

"B-R"はすべて "A"列と同じ条件です。このコードを入力するのではなく、 "A"と出力列だけを何度も繰り返して、カウンタと私のif文をループすることができます。

スクリプトは「結果ワークシート」のA7：A50列を参照し、「出力ワークシート」のB列にポイントを作成します。

列B（結果ワークシート）を見て、出力ワークシートの列Cに出力し、列C（結果ワークシート）を見てから列D（出力ワークシート）に出力しました。 ）。

Answer 1

多分これはあなたを助ける：R及び列ごとにマクロを適用します。

Private Sub CommandButton1_Click() 

Dim rng As Range 
Dim i As Integer 

Set rng = Range("A:R") ' define your range 

For i = 1 To rng.Columns.Count ' loop through the columns 

    counter = 2 'moves output 

    For Each n In Range(Cells(7, i), Cells(50, i)) 'loops through cell in specified column i 

    If n < 400 Then 
     Sheets("Output").Cells(counter, i + 1) = 0 'Output to other sheet, = points awarded 
    ElseIf n > 400 Then 
     Sheets("Output").Cells(counter, i + 1) = 3 'Output to other seet, = points awarded 


    End If 

    counter = counter + 1 'moves counter up 1 

    Next 
Next i 

End Sub 

私は範囲A内の各列を通過するループを追加しました。 >更新列「B」、

列「B」を評価 - - >更新

列「A」を評価：結果は、目的の列に適用されますので、私は、if文で「B」を交換しました列 "C" ...

これは役に立ちますか？

Answer 2

あなたの問題をうまく解決するために編集された回答。私が見るいくつかのことがあります。

まず、結果が出る前に各シートをアクティブにする必要があると思います。次に、出力するセルを特定した後に.valueを使用します。 3番目のセル（）関数は整数を使用するので、 "B"は2でなければなりません。

次のコードを使って試してみてください。

---

Private Sub CommandButton1_Click() 
    Dim r as Long 
    Dim c as Long 
    Dim lastrow as Integer 
    Dim lastcol as Integer 
    Dim cpath as String 

    cpath = Worksheets("SHEETNAME") 'less typing later on 
    cpath2 = Worksheets("Output") 
    lastrow = WorksheetFunction.CountA(Range("A:A")) 
    lstcolm = WorksheetFunction.CountA(cpath.Rows(1).EntireRow) 
    cpath.Cells(2,1).Activate 'assuming you have a header row 


    For c = 1 to lastcol 
    For r = 2 to lastrow 

If cpath.cells(r,c).value < 400 Then 

cpath2.Activate 
    cpath2.Cells(r, 2).value = 0 
ElseIf n > 400 Then 

cpath2.Activate 
    cpath2.Cells(r, 2).value = 3 
End If 

cpath.activate 

next r 
next c 

End Sub