人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

添付図のようなマクロが組みたいのですがうまくいきません。
お力を貸してください。

文字数が足りませんので、詳細はコメントに記載します。

1233754201
●拡大する


●質問者: Ryo0524
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:コメント マクロ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● airplant
●100ポイント ベストアンサー

何箇所か誤解されて作っているようなので、見直してみました。

  1. Sheet2の結果を書く行がmainブックのsheet1と同じ行になっている→sheet2のA列からIDで検索して、見つかったらそこへ文字をつなげていくように変更
  2. 【求人について】が毎回入っているので、最後にSheet2シートで入っている分を1回だけ見るように変更
'Option Explicit

Sub macro()

 Dim lastrow As Long
 Dim i As Long
 Dim j As Long  '@Add
 Dim wa As Worksheet
 Dim wb As String
 Dim kyuujinn As String
 Dim result As String
 Dim main As Range  'kyuujinのポインタ
 Dim Ans As Range  '@Add
 
 Workbooks.Open "C:\date\kyuujin.xls"
 Set wa = Workbooks("kyuujin.xls").Worksheets(1)
 
 lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
 j = 1  '@Add
 With Sheet2
 For i = 1 To lastrow
 
  '▼B列の値を設定する▼
 wb = ""
'@Del kyuujinn = ""
'@Del result = wb + kyuujinn
 
  'main.xlsのB列がある場合
 wb = wb & IIf(Sheet1.Range("B" & i).Value <> "", Sheet1.Range("B" & i).Value, "")
  'main.xlsのC列がある場合
 wb = wb & IIf(Sheet1.Range("C" & i).Value <> "", ":" & Sheet1.Range("C" & i).Value, "")
  'main.xlsのD列がある場合
 wb = wb & IIf(Sheet1.Range("D" & i).Value <> "", "(" & Sheet1.Range("D" & i).Value & ")", "")
' '求人についてがあるとき
' Set main = wa.Range("A:A").Find(Sheet1.Range("A" & i).Value)
' If Not main Is Nothing Then
' kyuujinn = vbNewLine & "【求人について】" & vbNewLine & _
' main.Offset(0, 1).Value
' End If
'
' result = wb + kyuujinn
 
 Set Ans = .Range("A:A").Find(Sheet1.Range("A" & i).Value)  '@Add
 If Ans Is Nothing Then  '@Add
  '初めてのIDなら新規行にする
 .Range("A" & j).Value = Sheet1.Range("A" & i).Value '@Mod
 .Range("B" & j).Value = wb  '@Mod
  '@Add Start
 j = j + 1
 Else
  ' 2つ目以降のIDなら既存行に文字をつなげる
 Ans.Offset(0, 1).Value = Ans.Offset(0, 1).Value & vbNewLine & wb  '@Mod
  '@Add End
 End If
 
 Next i
 
 For i = 1 To j - 1  '@Add
 Set main = wa.Range("A:A").Find(.Range("A" & i).Value)  '@Mod
 If Not main Is Nothing Then
 kyuujinn = vbNewLine & "【求人について】" & vbNewLine & _
 main.Offset(0, 1).Value
 .Range("B" & i).Value = .Range("B" & i).Value & kyuujinn
 End If
'@Del result = wb + kyuujinn
 Next i  '@Add
 
 End With
 
 Workbooks("kyuujin.xls").Close
 
End Sub
◎質問者からの返答

ありがとうございます。おかげで思っていたことが実行できました。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ