VBAの問題

Question

私はwsOutput内の各IDに... ... IDのあなたがここにws4の列EとFに表示のそれぞれを割り当てること

をしようとしています列Kおよび列Lにそれぞれ対応する。

私のコードは、エラーなして動作しますが、何も起こりません。これは私の最初のプロジェクトの一つですので、これは簡単な質問であればお詫び申し上げます。

は、私はまた、インターネットを相談した：

• http://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-mso_windows8/how-to-concatenate-multiple-rows-by-the-condition/fdd048ba-5405-4e53-b463-125f9cde2c0c?auth=1

• http://www.eileenslounge.com/viewtopic.php?f=27&t=12298

しかし、私は彼らのアプローチは、作業を取得することができませんでした。

ご協力いただきありがとうございます。

'Previous Code 
'wsOutput -> Filter Sheet - Worksheet (TARGET) ; ws4 = Search Skills - Worksheet (SOURCE) 
Dim separator As String, PreviousResultCG As String, NewResultCG As String, PreviousResultCategory As String, NewResultCategory As String 

If separator = "" Then separator = " , " 

'lRowInput = ws4.Range("A" & Rows.Count).End(xlUp).row - from above 
lRowOutput = wsOutput.Range("A4:A" & Rows.Count).End(xlDown).row 


With ws4 

    'For each ID on the Source-Worksheet 
    For Each ID In .Range("A2:A" & lRowInput) 

     'Find the respective ID on Target-Worksheet 
     Set FindID = wsOutput.Range("A4:A" & lRowOutput).Find(what:=ID, LookIn:=xlValues, lookat:=xlWhole) 

     'Get all CG ID's for the supplier and add them to previously found ID's of that supplier 
     If FindID = ID Then 

      PreviousResultCG = wsOutput.Range("K" & FindID.row).value 

      NewResultCG = PreviousResultCG & separator & .Range("E" & ID.row) 

      wsOutput.Range("K" & ID.row).value = NewResultCG 


      PreviousResultCategory = wsOutput.Range("L" & FindID.row).value 

      NewResultCategory = PreviousResultCategory & separator & .Range("F" & ID.row) 

      wsOutput.Range("L" & FindID.row).value = NewResultCategory 

     End If 

    Next ID 

End With 

Answer 1

「ソース」という名前のシートにソースデータを配置し、「ターゲット」という名前のソースデータから値を検索する別のシートを作成します。画像に表示されているように列を保持します。

以下のコードをモジュールに貼り付けてください。

Sub look_values() 

Dim id, source_id As Range 
Dim data_row_num, id_row_num As Long 
Dim source_sheet, target_sheet As Worksheet 
Dim cg, cat As String 

Set source_sheet = ThisWorkbook.Sheets("source") 
Set target_sheet = ThisWorkbook.Sheets("target") 
Set id = target_sheet.Range("A2") 

Do Until id.Value = "" 

    source_sheet.Activate 
    Range("A1").Activate 
    Set source_id = Range("A:A").Find(what:=id.Value, LookIn:=xlValues, lookat:=xlWhole) 
    On Error Resume Next 
    cg = Cells(source_id.Row, 5).Value 
    On Error Resume Next 
    cat = Cells(source_id.Row, 6).Value 
    target_sheet.Activate 
    Cells(id.Row, 11).Value = cg 
    Cells(id.Row, 12).Value = cat 
    Set id = id.Offset(1, 0) 
Loop 

End Sub 

マクロを実行する前に、両方のシートのID列の形式が同じであることを確認してください。 First Clean & ID列をトリムすることをお勧めします。対象のシートのID列に認識できない文字があるため、画像内に表示されます。