| |
▼lucky-cat-konkon さん：
今晩は。
イロハBOOKの、一番シートから、３番シートまでを検索し、ホヘトBOOKの、"記入用"というシートに記入するマクロを書きました。注意事項がいくつか有ります。
1.標準モジュールをホヘトBOOKに挿入し、下記コードを記入する。
2.ホヘトBOOKのシートに、"記入用"と名前を付け、A６から、横に、項目名を書いていく。
3.各BOOKの名称、シートの名称は、下記コードに出てくるのと完全に一致させる。（半角、全角に注意！）
4.項目名も、一致させる。出来ない場合は、イロハBOOKの方の項目名の上に、一列挿入して一致した項目名を書く。（たとえば、「氏名」の上のセルに、「つくった人」と書けば、つくった人でその行を特定できる。）
5.記入用シートのつくった人の欄（「つくった人」と書いてあるセルの下のセル）に名称を記入し、そのセルを選択した状態でマクロを動かす。（私は、ボタンのような丸い図形をシートに貼り付け、マクロを登録して、クリックする方法をいつもやっています。）
*私は、WINDOWS２０００と、ＥＸＣＥＬ９７で動作させて、順調に動かせました。私もプロではないので、lucky-cat-konkon さんのシステムでうまくいくかどうかは、やってみなければわかりません。うまくいかない場合は、また連絡してください。
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("イロハBOOK.xls")
gensi.Activate
シート
記入
End Sub
Private Sub シート()
For Each ws In gensi.Worksheets
If ws.Name = "一番シート" Or ws.Name = "二番シート" Or 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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
