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

お力を貸してください。
エクセルマクロでデータを編集し、CSV出力する方法について質問です。一番初めに実行できるマクロを作成してくださった方には最低300?500ポイント、その他の方には150?300ポイント。

条件
・a1.xlsのシート1
A列にID番号、B列に名前、C列にURL、D列にURLが書いてある

・b1.xlsのシート1
A列にID番号、B列に住所が書いてある
※このとき、B列の住所は空欄の場合もある
・c1.xlsのシート1
A列にID番号、B列に電話番号が書いてある
※A列のID番号は、a1.xlsのID番号、b1.xlsのID番号とは一致していない場合もある。

編集内容についてはコメントに記載します。
よろしくお願いします。

●質問者: yuko0909
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:A1 CSV URL xls エクセル
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● SALINGER
●500ポイント ベストアンサー

こんな感じでどうでしょうか。

また、a1.xlsとb1.xlsとc1.xlsを開いた状態で(ファイルの存在チェックとか簡略化するため)、

a1.xlsの標準モジュールにコードをコピーして実行してください。

同じ場所にa1.csvというファイル名で保存します。


Sub Macro()
 Dim lastRow As Long
 Dim i As Long
 Dim wb As Worksheet
 Dim wc As Worksheet
 Dim r As Range
 
 Set wb = Workbooks("b1.xls").Worksheets(1)
 Set wc = Workbooks("c1.xls").Worksheets(1)
 
 lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
 With Sheet2
 For i = 1 To lastRow
 .Range("A" & i).Value = Sheet1.Range("A" & i).Value
 If wb.Range("B" & i).Value <> "" Then
 .Range("B" & i).Value = "-1"
 Else
 .Range("B" & i).Value = "0"
 End If
 .Range("C" & i).Value = Sheet1.Range("B" & i).Value
 If Sheet1.Range("C" & i).Value <> "" Then
 .Range("D" & i).Value = Mid(Sheet1.Range("C" & i).Value, _
 InStrRev(Sheet1.Range("C" & i).Value, "/") + 1)
 .Range("E" & i).Value = Mid(Sheet1.Range("D" & i).Value, _
 InStrRev(Sheet1.Range("D" & i).Value, "/") + 1)
 Else
 If Sheet1.Range("D" & i).Value <> "" Then
 .Range("D" & i).Value = Mid(Sheet1.Range("D" & i).Value, _
 InStrRev(Sheet1.Range("D" & i).Value, "/") + 1)
 End If
 End If
 Set r = wc.Range("A:A").Find(Sheet1.Range("A" & i).Value)
 If Not r Is Nothing Then
 .Range("F" & i).Value = r.Offset(0, 1).Value
 End If
 Next i
 End With
 
 ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\a1.csv", _
 FileFormat:=xlCSV, CreateBackup:=False

End Sub
◎質問者からの返答

ありがとうございます!!!

思ってた通りに実行できました。

関連質問


●質問をもっと探す●



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