0

VBA初心者なのでお手柔らかにお願いします.....

重複をチェックして列にカウントを挿入するスクリプトがありますが、これは正常に機能しますが、シートが異なることが多いため、重複をチェックする列とカウントを挿入する列をユーザーに尋ねる必要があります。スクリプトを修正しましたが、宛先列にゼロしか入力されません。何が問題なのかわかりません。どんな助けでも素晴らしいでしょう。前もって感謝します。

Sub LookForDuplicates()

Dim LastRow As Long

Dim column1 As String
'display an input box asking for column
column1 = InputBox( _
"Please enter column to ckeck")
'if no file name chosen, say so and stop
If Len(column1) = 0 Then
MsgBox "No column entered"

Exit Sub
End If

Dim column2 As String
'display an input box asking for column
column2 = InputBox( _
"Please enter column to insert results")
'if no file name chosen, say so and stop
If Len(column2) = 0 Then
MsgBox "No column entered"

Exit Sub
End If

'-------------------------------------------------------

'これは、設定された列を使用したスクリプトの元のバージョンであり、うまく機能します.....ただし、チェックする列と、結果が入力される列をユーザーが指定する必要があります。

  'LastRow = Range("B" & Rows.Count).End(xlUp).Row
  '   With Range("E1")
  '  .FormulaR1C1 = "=COUNTIF(C2,RC[-3])"
  '  .AutoFill Destination:=Range("E1:E" & LastRow)
  '   Range("E1").Select
  '  ActiveCell.FormulaR1C1 = "Duplicates"
'-----------------------------------------------------   
LastRow = Range(column1 & Rows.Count).End(xlUp).Row
 With Range(column2 & "1")
.FormulaR1C1 = "=COUNTIF(C2,RC[-3])"
.AutoFill Destination:=Range(column2 & "1" & ":" & column2 & LastRow)
 Range(column2 & "1").Select
ActiveCell.FormulaR1C1 = "Duplicates"

  End With
End Sub

ユーザー入力変数でこれを機能させることができません。何か不足している場合は申し訳ありませんが、これに関するリソースが見つかりません....

式: =COUNTIF($B:$B,B2) は、マクロ内以外では機能します。

=COUNTIF($column1:$column1,column12) のようなユーザー入力からの変数に置き換えられたマクロにこの行を追加する必要がありますが、構文エラーが発生し続けます。

ありがとう。

4

2 に答える 2

0

他の誰かがこれが役に立つと思うかもしれない場合の解決策：

問題は、列1が列参照Hとして入力された場合でも発生しました。たとえば、COUNTIF関数はこれを数値参照として必要としたため、column1値に変数を追加し、数式を適切に変更しました。すべてが現在機能しています：

Dim LastRow As Long

Dim column1 As String
'display an input box asking for column
column1 = InputBox( _
"Please enter column to ckeck")
'if no file name chosen, say so and stop
ColumnNumber = Columns(column1).Column

If Len(column1) = 0 Then
MsgBox "No column entered"


Exit Sub
End If

Dim column2 As String
'display an input box asking for column
column2 = InputBox( _
"Please enter column to insert results")
'if no file name chosen, say so and stop
If Len(column2) = 0 Then
MsgBox "No column entered"

Exit Sub
End If

LastRow = Range(column1 & Rows.Count).End(xlUp).Row
     With Range(column2 & "1")
    .FormulaR1C1 = "=COUNTIF(C" & ColumnNumber & ",C" & ColumnNumber & ")"
    .AutoFill Destination:=Range(column2 & "1" & ":" & column2 & LastRow)
     Range(column2 & "1").Select
    ActiveCell.FormulaR1C1 = "Duplicates"

  End With
End Sub
于 2013-03-07T08:52:48.803 に答える
0

入力ボックスから /Text 値を期待している場合は、Stringそれを指定する必要があります。

Dim column1 As String
'display an input box asking for column
column1 = InputBox("Please enter column to ckeck", "Range to Check", , , , 2)

ここで文字列をジャグリングする代わりに、Rangeユーザーがチェックしたい列の全範囲または1つのセルをクリックするだけでよいオブジェクトを使用してみませんか..

範囲を使用して入力ボックスのデータを取得する:主な問題は、式の列をチェックする範囲を設定しているようです。

Option Explicit

Sub LookForDuplicates()
    Dim LastRow As Long, StartRow as Long
    Dim column1 As Range, column2 As Range

    Set column1 = Application.InputBox("Please enter _ 
            column to ckeck", "Range to Check", , , , , , 8)
    If column1 Is Nothing Then
        MsgBox "No column entered"
        Exit Sub
    End If

    Set column2 = Application.InputBox("Please _ 
                  enter column to insert results", _
                              "Range to Output Results", , , , , , 8)
    If column2 Is Nothing Then
        MsgBox "No column entered"
        Exit Sub
    End If

    LastRow = Cells(Rows.Count, column1.Column).End(xlUp).Row '--updated here
    StartRow = column2.Row '-- here a new code added, assuming that you will have at least one row for column titles 
     With column2
        .FormulaR1C1 = "=COUNTIF(R" & column1.Row _ 
                & "C[-1]:R" & LastRow + 2 & "C[-1],RC[-1])"
        .AutoFill Destination:=column2.Resize(LastRow - StartRow, 1)
    End With
    column2.Offset(-1, 0).FormulaR1C1 = "Duplicates"
End Sub

出力：

ここに画像の説明を入力

于 2013-01-14T17:38:08.847 に答える