【図(1)】の値を【図(2)】【図(3)】の該当セ

【図(1)】book1sheet1の品名を【図(2)】book2sheet2または【図(3)】book2shee3の該当するセルに転記するマクロなんですが

例）
【図(1)】のa801蜜柑は、a801から"a"でbook2のsheet2を検索、"8"から8Aを検索、"01"から１を検索し、【図２】のE3が該当セルになります。
【図(1)】のb808西瓜は、b808から"b"でbook2のsheet3を検索、"8"から8Bを検索、"08"から８を検索し、【図(3)】のC44が該当セルになります。

こんな感じです。よろしくお願いします。

No.5 ベストアンサー 回答者： optimumsoup 回答日時： 2013/03/05 17:43

お答えします。

マクロを働かせるときに、シート2か3を開いているとエラーになりました。
そこでどのシートを開いているか関係なく、動くようプログラムを変えました。試してみてください。念のためにですが、シート1はシート2、3と同じファイルに入っています。

Option Explicit


Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2013/3/4 ユーザー名 :
'
Dim i As Integer, sh As String, cho As Integer, ban As Integer, itm As String, bango As String, shtn As Integer, go As Integer, kum As Integer, ln As Integer, col As Integer
Worksheets(1).Activate
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
bango$ = Cells(i, 1)
sh = Left$(bango$, 1)
'MsgBox sh

cho = Mid(bango$, 2, 1)
'MsgBox cho
ban = Mid(bango$, 3, 2)

'MsgBox ban
itm = Cells(i, 2)

'MsgBox itm
Select Case sh
Case Is = "a"
shtn = 2
Case Is = "b"
shtn = 3
End Select
'MsgBox shtn


If ban < 5 Then
kum = (8 - cho) * 6 + 1

Else
kum = (8 - cho) * 6 + 4

End If

'MsgBox kum

Select Case ban
Case Is = 1
go = 5
Case Is = 2
go = 4
Case Is = 3
go = 3
Case Is = 4
go = 2
Case Is = 5
go = 1
Case Is = 6
go = 5
Case Is = 7
go = 4
Case Is = 8

go = 3
Case Is = 9 = 2
Case Is = 10
go = 1

End Select
ln = kum + 2
col = go

Worksheets(shtn).Cells(ln, col) = itm

Next


'
End Sub

この回答へのお礼

ありがとうございます。

順調に動いてます。
いろいろ応用していきたいと思います。
sheet2、sheet3の列数なども可変にできるのでしょうか？
列数が100ぐらいになると
Select Case ban
Case Is = 100
go = 1
ここは100とか200まで入力しないとだめですか？

お礼日時：2013/03/06 15:10

No.4 回答者： optimumsoup 回答日時： 2013/03/05 10:28

NO3です。

もう解決したと思いますが、データ数が不定の場合でも対応できるようプログラムを直しましたので、答えさせてください。

Option Explicit


Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2013/3/4 ユーザー名 :
'
Dim i As Integer, sh As String, cho As Integer, ban As Integer, itm As String, bango As String, shtn As Integer, go As Integer, kum As Integer, ln As Integer, col As Integer

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
bango = Cells(i, 1)
sh = Left$(Cells(i, 1), 1)
'MsgBox sh

cho = Mid(Cells(i, 1), 2, 1)
'MsgBox cho
ban = Mid(Cells(i, 1), 3, 2)

'MsgBox ban
itm = Cells(i, 2)

'MsgBox itm
Select Case sh
Case Is = "a"
shtn = 2
Case Is = "b"
shtn = 3
End Select
'MsgBox shtn


If ban < 5 Then
kum = (8 - cho) * 6 + 1

Else
kum = (8 - cho) * 6 + 4

End If

'MsgBox kum

Select Case ban
Case Is = 1
go = 5
Case Is = 2
go = 4
Case Is = 3
go = 3
Case Is = 4
go = 2
Case Is = 5
go = 1
Case Is = 6
go = 5
Case Is = 7
go = 4
Case Is = 8

go = 3
Case Is = 9 = 2
Case Is = 10
go = 1

End Select
ln = kum + 2
col = go

Worksheets(shtn).Cells(ln, col) = itm

Next


'
End Sub

この回答への補足

何度もありがとうございます。

該当セルに転記されません。
例えば
sheet1 a:aの番号下二桁05はsheet2またはsheet3の表の該当セルに転記されないか10に転記されてしまいます。
同じように08は転記されません。09は8に転記されてしまいます。
なかなかうまくいかないものです。
よく止まってしまうのが
cho = Mid(Cells(i, 1), 2, 1)
Worksheets(shtn).Cells(ln, col) = itm
です。

補足日時：2013/03/05 12:46

No.3 回答者： optimumsoup 回答日時： 2013/03/04 20:11

No2です。

お返事をいただいたので、再度マクロをチェックしてみたところ、正常に作動いたしました。ただBOOK1のしーと1のデータはBOOK2のシート1にコピーしています。そしてマクロはBOOK2のマクロに入れてあります。そういうわけで私はあなたのパソコンでなぜ動かないか、お答えすることができません。

この回答への補足

ありがとうございます。

すべての表は可変なんです。
http://i.imgur.com/z5b22wh.jpg

補足日時：2013/03/04 21:13

No.2 回答者： optimumsoup 回答日時： 2013/03/04 15:19

一応答えができましたのでお答えします。

ただしbook1
のシートはbook2のシート1にあるものとしてマクロを作っています。

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2013/3/4 ユーザー名 :
'
Dim i As Integer, sh As String, cho As Integer, ban As Integer, itm As String, bango As String, shtn As Integer, go As Integer, kum As Integer, ln As Integer, col As Integer
For i = 2 To 6
bango = Cells(i, 1)
sh = Left$(Cells(i, 1), 1)
'MsgBox sh

cho = Mid(Cells(i, 1), 2, 1)
'MsgBox cho
ban = Mid(Cells(i, 1), 3, 2)

'MsgBox ban
itm = Cells(i, 2)

'MsgBox itm
Select Case sh
Case Is = "a"
shtn = 2
Case Is = "b"
shtn = 3
End Select
'MsgBox shtn

Select Case cho
Case Is = 8
If ban < 5 Then
kum = 1
'ElseIf
Else
kum = 4
End If
Case Is = 7
If ban < 5 Then
kum = 7
Else
kum = 10
End If

End Select
'MsgBox kum

Select Case ban
Case Is = 1
go = 5
Case Is = 2
go = 4
Case Is = 3
go = 3
Case Is = 4
go = 2
Case Is = 5
go = 1
Case Is = 6
go = 5
Case Is = 7
go = 4
Case Is = 8

go = 3
Case Is = 9
go = 2
Case Is = 10
go = 1

End Select
ln = kum + 2
col = go

Worksheets(shtn).Cells(ln, col) = itm

Next


'

この回答へのお礼

http://i.imgur.com/YDiOVdv.jpg

ありがとうございます。
ここに図をアップしてみました。
F列は全角になっています。

いまのところ、うまく動きません。

お礼日時：2013/03/04 16:53

No.1 回答者： katsuyausami 回答日時： 2013/03/04 15:05

ご質問の意図がいまいちよく分からないのですが。

sheet2やsheet3の表は固定ですか。つまり、例えばsheet2でいうとF列で8A（画像が不鮮明なのですが8Aですよね）になっているところは1～6行目、7Aのところは7～12行目になっていますが、この行位置と行数は変わらないと言う事で良いですか（8Aの上に9Aが追加されて、8Aが7～12行目になることはあるかと言うです。また、各6行というのが8行になったりしないかと言いう事です）。また、よこに見て、A～F列を使っていますが、これがA～G列に増えたりと言う事もないですか。

何を言いたいかと言いますと、検索によらなくても、品目の番号によって、転記先の位置は決まっているのではないでしょうか、と言う事です。

頭の1ケタがaならSheet2、bならSheet3を使う。

2文字目が8なら1～6行目、7なら7～12行目を使う
（仮に最初の行（1,7行目）をaとします）
（なお、aの値は2文字目の数字をnとすると49-（6×n）で決まりますね）。

後ろ2ケタが01（仮に(1)とします）なら、a+2行目の（6-(1)）列目が転記位置、
後ろ2ケタが5より大きければ、例えば08（仮に(8)とします）なら、a+5行目の（11-(8)）列目が転記位置になると思います。

表の行数、列数、行位置等に変化がないのであれば、これをそのままプログラムに書いてしまうと良いでしょうし、変化があるのであれば、この品目の番号から行位置、列位置に変換すること自体の変換表を作ればスッキリすると思います。

ただ、ご質問だけを見ると、sheet1なしで、いきなりSheet2やSheet3に品名を書いたら良いのではとも思うのですが・・。

ご質問の趣旨と外れているようにも思いますので、そうでしらご容赦ください。