Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

66295 / 76807

←次へ　｜　前へ→


	【15077】Re:『データの突合』

lucky-cat - 04/6/15(火) 11:17 -


	引用なし

	パスワード

BBさんいつもありがとうございます。
やはりERRがでちゃいます。
具体的に書きます。
ＡＢＯＯＫ
ＢＢＯＯＫがあります。
ＡＢＯＯＫにはシートは１個で一覧という名前です。
列には場所、建物、種類
ＢＢＯＯＫにもシートは1個で局名という名前とします
列には場所　場所Ｂ　情報という列とします。

両ＢＯＯＫの場所をキーに一致したら
ＢＢＯＯＫの記入という新シートに
場所　建物　　情報を表示するというものです。

ＢＢＯＯＫに記入用シート作成

Option Explicit

Dim vv() As Variant

Dim gensi As Object, yousi As Object

Dim s As String

Dim i As Integer, j As Integer, ir As Integer, ic As Integer

Dim r As Range

Dim ws As Worksheet

Sub 基地()

Set yousi = ThisWorkbook.Worksheets("記入用")
s = ActiveCell.Value

i = MsgBox(s & "一致させます？", vbYesNo)
If i <> vbYes Then Exit Sub

i = 0

Do While Range("a6").Offset(, i).Value <> ""
　　i = i + 1
　　ReDim Preserve vv(2, i)
　　vv(1, i) = Range("a6").Offset(, i - 1).Value
Loop

Set gensi = Workbooks("ＡＢＯＯＫ.xls")
gensi.Activate
シート
記入

End Sub

Private Sub シート()

For Each ws In gensi.Worksheets
　　If ws.Name = "一覧"　Then
　　　　ws.Activate
　　　　検索
　　End If
Next ws

End Sub

Private Sub 検索()

For Each r In ws.UsedRange
　　If r.Value = s Then
　　　　ir = r.Row
　　　　Exit For
　　End If
Next r

For j = 1 To i
　　For Each r In ws.UsedRange
　　　　If r.Value = vv(1, j) Then
　　　　　　ic = r.Column
　　　　　　vv(2, j) = Cells(ir, ic).Value
　　　　　　Exit For
　　　　　　MsgBox vv(2, j)
　　　　End If
　　Next r
Next j

End Sub

Private Sub 記入()

yousi.Activate

For j = 1 To i
　　Cells(ActiveCell.Row, 1).Offset(, j - 1).Value = vv(2, j)
Next j

End Sub

すみません！用語の意味がわからなくて・・。

0 hits

▼

【14952】『データの突合』（ lucky-cat 04/6/11(金) 17:40