Excel VBA質問箱 IV

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

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


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

41048 / 76736

←次へ　｜　前へ→


	【40773】Re:検索にかけ転記したいのですが。

ナイスプログラム

- 06/7/23(日) 21:27 -


	引用なし

	パスワード

　今晩は。やって見ました。

　
　値は完全に一致させないと合わないのでご注意下さい。たとえば、
”４月”と”4月”は、合いません。詳細シートの項目を売上シートに
コピーすれば確実です。売上シートの製造番号は数値として扱っています。
これがもし文字列だったらうまく行きません。テストして見て下さい。

Option Explicit
Option Base 1

Const sb1 As String = "詳細11" 'ブックの名称をここに書く。
Const sb2 As String = "詳細22"
Const sb3 As String = "詳細33"
Const sb4 As String = "詳細44"
Const sb5 As String = "詳細55"

Dim ss(5) As String
Dim sinki As Object
Dim vv As Variant
Dim b As Boolean

Sub 詳細記入()

b = False

Call 配列記入(sb1)
Call 配列記入(sb2)
'Call 配列記入(sb3)
'Call 配列記入(sb4)
'Call 配列記入(sb5)

End Sub

Private Sub 配列記入(s1 As String)

Dim i As Integer, j As Integer

Workbooks.Open ThisWorkbook.Path & "\" & s1 & ".xls"
vv = Workbooks(s1 & ".xls").Worksheets(1).UsedRange.Value
vv(1, 1) = Val(Mid(vv(1, 1), 5, Len(vv(1, 1))))

For j = 2 To UBound(vv, 2)
　　For i = 3 To UBound(vv, 1)
　　　　vv(2, j) = vv(2, j) + vv(i, j)
　　Next
Next

用紙記入

End Sub

Private Sub 用紙記入()

Dim r As Range, rr1 As Range, rr2 As Range
Dim i As Integer, j As Integer, ir As Integer, ix As Integer

If b = False Then
　　ThisWorkbook.Worksheets("売上").Copy
　　Set sinki = ActiveWorkbook
　　b = True
End If

With sinki.Worksheets("売上")
　　For i = 2 To 6
　　　　If .Cells(i, 1).Value = vv(1, 1) Then
　　　　　　ir = i
　　　　　　Exit For
　　　　End If
　　Next
　　
　　For i = 2 To UBound(vv, 2)
　　　　For j = 2 To 13
　　　　　　If .Cells(1, j).Value = vv(1, i) Then
　　　　　　　　.Cells(ir, j).Value = vv(2, i)
　　　　　　End If
　　　　Next
　　Next
End With
　　　　

End Sub

0 hits

▼

【40743】検索にかけ転記したいのですが。 toy 06/7/22(土) 1:11