[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『別シ−トヘ自動転記』（みこ）
[[20090803103642]] 『別シ−トヘ自動転記』（みこ）
お世話になっています。
日立も 日立1棟 日立2棟 あることがわかり 下記のコ−ドに入れたいのですが わからず 下記のコ−ドを利用して 別のボタンを作り動作させています。 合体させるには どのようにすればよいのでしょうか。。
Sub ボタン1_Click()
Dim sn, mr As Date
Dim i As Long
On Error Resume Next
If ActiveSheet.Name <> "本日予定表" Then
MsgBox "本日予定表シートをアクティブにして 実行して下さい。"
Else
mr = Range("A" & Rows.Count).End(xlUp).Row
If mr < 6 Then
MsgBox "データが有りません。"
Else
For i = 6 To mr
sn = Range("I" & i).Value
If sn <> "" Then
If Left(sn, 2) = "東芝" Then
sn = "東芝"
End If
With Sheets(sn).Range("A" & Rows.Count).End(xlUp).Offset(1)
If Err = 0 Then
.Range("A1").Value = Range("C4").Value
.Range("C1").Value = Range("G" & i).Value
.Range("J1").Value = Range("D" & i).Value
.Range("I1").Value = Range("L" & i).Value
.Range("K1").Value = Range("AC" & i).Value
.Range("L1").Value = Range("AD" & i).Value
.Range("M1").Value = Range("AE" & i).Value
.Range("N1").Value = Range("AF" & i).Value
.Range("O1").Value = Range("AG" & i).Value
.Range("P1").Value = Range("AH" & i).Value
.Range("R1").Value = Range("AI" & i).Value
.Range("S1").Value = Range("AJ" & i).Value
.Range("T1").Value = Range("AK" & i).Value
.Range("U1").Value = Range("AL" & i).Value
.Range("V1").Value = Range("AM" & i).Value
.Range("W1").Value = Range("AN" & i).Value
.Range("X1").Value = Range("AO" & i).Value
If sn = "東芝" Then
.Range("BB1").Value = Range("I" & i).Value
End If
Range("D" & i & ":G" & i).ClearContents
Range("I" & i).ClearContents
Range("L" & i & ":N" & i).ClearContents
Range("AJ" & i).ClearContents
Range("AC" & i & ":AO" & i).ClearContents
Else
MsgBox "転記を開始します。" & vbCrLf & _
"一度転記したら変更できません。再度確認してください。"
Err = 0
End If
End With
End If
Next
End If
End If
End Sub
新たなボタン(日立用)
Sub ボタン2_Click()
Dim nn, mr As Date
Dim i As Long
On Error Resume Next
If ActiveSheet.Name <> "本日予定表" Then
MsgBox "本日予定表シートをアクティブにして 実行して下さい。"
Else
mr = Range("A" & Rows.Count).End(xlUp).Row
If mr < 6 Then
MsgBox "データが有りません。"
Else
For i = 6 To mr
nn = Range("I" & i).Value
If nn <> "" Then
If Left(nn, 2) = "日立" Then
nn = "日立"
End If
With Sheets(nn).Range("A" & Rows.Count).End(xlUp).Offset(1)
If Err = 0 Then
.Range("A1").Value = Range("C4").Value
.Range("C1").Value = Range("G" & i).Value
.Range("J1").Value = Range("D" & i).Value
.Range("I1").Value = Range("L" & i).Value
.Range("K1").Value = Range("AC" & i).Value
.Range("L1").Value = Range("AD" & i).Value
.Range("M1").Value = Range("AE" & i).Value
.Range("N1").Value = Range("AF" & i).Value
.Range("O1").Value = Range("AG" & i).Value
.Range("P1").Value = Range("AH" & i).Value
.Range("R1").Value = Range("AI" & i).Value
.Range("S1").Value = Range("AJ" & i).Value
.Range("T1").Value = Range("AK" & i).Value
.Range("U1").Value = Range("AL" & i).Value
.Range("V1").Value = Range("AM" & i).Value
.Range("W1").Value = Range("AN" & i).Value
.Range("X1").Value = Range("AO" & i).Value
If nn = "日立" Then
.Range("BB1").Value = Range("I" & i).Value
End If
Range("D" & i & ":G" & i).ClearContents
Range("I" & i).ClearContents
Range("L" & i & ":N" & i).ClearContents
Range("AJ" & i).ClearContents
Range("AC" & i & ":AO" & i).ClearContents
Else
MsgBox "転記を開始します。" & vbCrLf & _
"一度転記したら変更できません。再度確認してください。"
Err = 0
End If
End With
End If
Next
End If
End If
End Sub
宜しくお願いします。
たとえば
If Left(sn, 2) = "東芝" Then
sn = "東芝"
End If
を
If Left(sn, 2) = "東芝" Or Left(sn, 2) = "日立" Then
sn = Left(sn, 2)
End If
と
If sn = "東芝" Then
.Range("BB1").Value = Range("I" & i).Value
End If
を
If sn = "東芝" Or sn = "日立" Then
.Range("BB1").Value = Range("I" & i).Value
End If
に変更してみるのはどうでしょう？
それから。。。。 お名前は指摘するつもりはありませんので （タイミング的に、たまたま前の回でお伺いしただけですから。） これまでのものはそのままで もし宜しければ、新たにご質問をなさる時に だんだんと統一をして行って頂ければと思います。 もちろん、過去のものでも統一させた方が良いと 思っておられるのでしたら ご自由になさって頂ければ良いと思いますが。
(HANA)
HANAさん
ありがとうございます。
Orを使うことで出来たのですね。
私は
Andを使ったのですが
駄目でした。
ボタンを2つにしようかなと
思っていました。
If Left(sn, 2) = "東芝←削除
" And Left(sn, 2) = "日立" Then
sn = Left(sn, 2)
>もし宜しければ、新たにご質問をなさる時に >だんだんと統一をして行って頂ければと思います。 はい、わかりました。
（みこ）
＞If Left(sn, 2) = "東芝○△◇" And Left(sn, 2) = "日立" Then のコードは実際にやってみたコードですか？ それとも ここへ載せるために「こんな感じでやった」 と新たに書かれたコードでしょうか？
＞Andを使ったのですが ＞駄目でした。 そうですね。
「東芝」で(且)「日立」のもの ではなく 「東芝」または「日立」のもの ですから And ではなく Or になりますね。
それから、実際に載せられたコードをやっておられた場合。。 Left(sn, 2)は snの文字列の左から二文字分を取り出すので = "東芝○△◇" と５文字と比べるのは変ですよ？
(HANA)
コードを見ていて思ったのですが シートが無かった場合（を想定して） メッセージボックスが出るようになってますよね？
ですが、出るだけで中断出来ませんよね。
そこで
If MsgBox(i & "行目は転記出来ません。" & vbCrLf & _
"続けて処理しますか？", vbYesNo) = vbNo Then
Exit For
End If
って感じで、中断出来るようにしてみてはどうでしょう。
それとも「転記を開始します。」って事は 転記処理がされる前にこの部分が走ることになっているのかな。。。？ でしたら、コードは修正が必要 って事だと思いますが。
それから
mr = Range("A" & Rows.Count).End(xlUp).Row
ここで、A列の入力がある最終行まで処理する事になっていますが
どうやらA列は転記も削除もされていない様子。
本当に、A列の入力がある最終行までの処理で良いのでしょうか？
(HANA)
どうして編集してしまうの？ 話の流れがおかしくなりますし 私は自分のコメントを消されたいとは思いません。
書き間違えなら、書き間違えだったと 書けばよいだけの話だと思いますが。
(HANA)
HANAさん かってに 「←削除」してしまい申し訳ありません。 私のミスによるものです。 その部分「実名」なので 載せたくないもので お許しください。
>↑のコードは実際にやってみたコードですか？ 実行してみました。 いけると思い でも動きませんでした。
>と５文字と比べるのは変ですよ？ 理解しています。 本来なら Left(sn, 5)ですよね。
>If MsgBox(i & "行目は転記出来ません。" & vbCrLf & _
>"続けて処理しますか？", vbYesNo) = vbNo Then
>Exit For
>End If
前回では
MsgBox i & " 行目は転記出来ません。" & vbLf & _
"I" & i & " セルの値 （" & Range("I" & i).Value & "） を確認して下さい。"
を教えていただいたのですが
転記できなく
これ以上 忙しいHANAさんを手ずらわしたくなかったもので 私なりに変えて動作したので ま−いいかな なんて思い このようにしました。
>本当に、A列の入力がある最終行までの処理で良いのでしょうか？ A列にはC列からのIF関数が入っているので 問題ないとおもいました。
（みこ）
＞その部分「実名」なので ＞載せたくないもので ＞お許しください。 でしたら、○△◇の様に変更すれば良いと思います。 一緒に理由が書いてあれば 「それでも一度書いたものを変更するな」 と言う人は居ないと思いますよ。
＞本来なら ＞Left(sn, 5)ですよね。 どちらを「本来」とするのか分かりませんが 先頭の５文字がどうなっているのか調べるなら そうでしょうね。
＞を教えていただいたのですが ＞転記できなく ちょっと意味が分かりません。
＞＞MsgBox i & " 行目は転記出来ません。" & vbLf & _
＞＞"I" & i & " セルの値 （" & Range("I" & i).Value & "） を確認して下さい。"
は駄目で
＞MsgBox "転記を開始します。" & vbCrLf & _ ＞ "一度転記したら変更できません。再度確認してください。" なら良いってこと？ メッセージ文の内容の変更だけでは 動きは変わらないと思いますが。。。
＞A列にはC列からのIF関数が入っているので ＞問題ないとおもいました。 「動けばよい」と言う段階から一歩進むとしたら どこまでループするのが良いと思いますか？
C列に入力がある行を転記するなら C列の入力がある最終行までループさせるのが 自然だと思いますが。
＞A列にはC列からのIF関数が入っているので これだと、数式が事前に入力されている行までループします。 実行前に、A列の数式が入っている最終行数と C列の入力がある最終行数を あわせる訳ではないんですよね？
(HANA)
HANAさん ありがとうございます。 >○△◇の様に変更すれば良いと思います。 そうですね あわて急いで事を行うと このような結果を招いてしまいました。 ドジなんです 私は。。。 なにぶんにも仕事中にての返事ですので ネットに繋げ すぐにコ−ピして ワ−ドに貼り付けて 返答を打っています。 返答をコピペしています。 私としは HANAさんへ直ぐにでも返事を打ちたいのですが 仕事で遅れる場合があります。 お許しください。
あれ〜どちらも転記できました
が
＞＞＞MsgBox i & " 行目は転記出来ません。" & vbLf & _
＞＞＞"I" & i & " セルの値 （" & Range("I" & i).Value & "） を確認して下さい。"
だと
最初に
8行目は転記出来ません。I8セルの値を確認して下さい。
と表示が出てしまいます。
>これだと、数式が事前に入力されている行までループします。
そうでしたか
だったら
mr = Range("C" & Rows.Count).End(xlUp).Row
に変更しなくてはいけませんね。
運用前でよかったです。
（みこ）
＞だと ＞最初に ＞8行目は転記出来ません。I8セルの値を確認して下さい。 ＞と表示が出てしまいます。
そしたら、みこさんが載せておられるメッセージにしても 8行目の所でメッセージボックスが表示されると思いますが？ （行番号が表示されないので どの行でメッセージが出ているか 分からないだけで。）
そして、8行目はやはり転記されていないのではないかと思いますが。。。？
(HANA)
HANAさん、そして皆さん おはようございます。 明日は、新しい党の総理が決まりますね。 少しで日本が良くなることを期待して。。。
今回作ってうちに
8,9行目は表題にしました。
10行目からの転記になります。
Else
mr = Range("C10" & Rows.Count).End(xlUp).Row
If mr < 6 Then
MsgBox "データが有りません。"
Else
と
End If
With Sheets(sn).Range("C10" & Rows.Count).End(xlUp).Offset(1)
If Err = 0 Then
と 変えてみたのですが「データが有りません」表示で 駄目でした。
If mr < 6 Then For i = 6 To mr こちらの数字も 色々変えてみたのですが 「8行目は転記出来ません。I8セルの値を確認して下さい。」 表示で 駄目でした。
（みこ）
＞8,9行目は表題にしました。 ＞10行目からの転記になります。 本日予定表シートのレイアウトが変更になったのですか？
Range("C" & Rows.Count) これは、C列のワークシートの最終行
2003迄のエクセルなら ワークシートの最終行は65536行なので
C65536セルの事を表します。
そこから、.End(xlUp).Row したセルが C列で入力が有る最終行のセルです。
＞If mr < 6 Then
8,9行目が表題なら
このセルの行番号・・Range("C" & Rows.Count).End(xlUp).Row・・
が 9 以下の場合（10未満の場合）
転記するデータが無いことになりますよね？
＞For i = 6 To mr 前回は6行目から転記だったのが 10行目から転記する事にしましたね。
今回の i は
nn = Range("I" & i).Value
この辺り／~~~~~~~~
と直接関係しています。
たぶん6,7行目はI列に入力が無いと思います。 ですから、If nn <> "" Then で処理されません。
i = 8 に成った場合 nn には I8 セルの値が入ります。 そして、I8 セルで指定されているシートに 8行目のデータを転記しようとします。
でも、実際は8行目はタイトル行で その様なシート名は無いのでエラーになります。 よって 転記もされません。
10行目から転記なら、10行目から始まるように すればよいと思いますよ。
それから こちらも基本的には Rows.Count なんで同じですが。。。
＞With Sheets(sn).Range("C10" & Rows.Count).End(xlUp).Offset(1)
これは Sheets(sn) シートに関する事なので
変更は不要に思いますが。。。？
こちら（各転記先シート）もレイアウトの変更が有りましたか？
[ステップインで実行]するとコードの動きが確認出来ます。 また、カーソルを近づけてしばらく待つと 何のデータが処理されているのか確認出来ます。
動きがおかしい時は、一つずつ確認していってもらうのが良いと思います。 例えば、今回の場合 ６行目の処理から始まります。 その時に「10行目からで良いのに」と思って下さい。
(HANA)
>本日予定表シートのレイアウトが変更になったのですか？ はい、作っていくうちで変更しました。
For i = 6 To mr
↓
For i = 10 To mr
に変えてやれば
検証OK
For i = 10 To mr
Range("I" & i)の10行目から
mr(C65536)まで繰り返しなさいですよね。
>こちら（各転記先シート）もレイアウトの変更が有りましたか？ 転記先は、変更なしです。
If mr < 6 Then MsgBox "データが有りません。"
もしmr(C65536)が6より小さい場合は メッセ−ジをだしなさい。
Else mr(C65536)が6より大きい場合は、 For i = 10 To mr を実行しなさいですよね。
以前にも HANAさんに教わった >[ステップインで実行]するとコードの動きが確認出来ます。 するのを すぐに忘れてしまいます。 コードの動作確認大切ですよね。
（みこ）
みこさん！！びみょ〜ですよ！！（ニドメ・笑）
＞mr(C65536)まで繰り返しなさいですよね。 ＞mr(C65536)が6より小さい場合は ＞mr(C65536)が6より大きい場合は mr は C65536 では無いですが 常識的に考えると C65536セルの状態は関与しない と言う事になると思いますが 大丈夫ですか？ 「.End(xlUp).Row」を付け忘れているだけ？
それに、データは10行目から入力なんですよね？ 6行目ではなくて。
(HANA)
.End(xlUp).Rowの意味を教えてください。
（みこ）
.End(xlUp).Rowで入力した最終セル行を確認しているんですよね。
（みこ）
HANAさん やっと理解できました。 できの悪い人に 教えるのは大変ですね(笑)
転記させる時は、 全ての作業を終えたことを確認して 行います。 転記しなくても良い納入もあるので 「行目は転記出来ません。」 の表示がでたら その行を削除もしくは白紙にする方法って できるのでしょうか?
（みこ）
＞その行を削除もしくは白紙にする方法 出来ますが、間違って入力していた場合は どうするんですか？
例えば、「東し芝」って感じで 間違えて打っていた時 とか。
まぁ、確認して消すようにすれば良いのかもしれませんが。
＞転記しなくても良い納入 ってのは、どの様な物がどれくらい有るのでしょう？ また、どの様に判断するのでしょう？
因みに、こう言う情報は コードを見直すのが良い場合が有りますよ。
それから、せっかく打ったデータですから もう一枚くらいシートを増やして その他シートを作成しておくのが良いと思いますが。
I列の打ち間違いや、「やっぱり・・・」なんて時に そこからデータをそれぞれのシートへ移動するだけで 済むように成りますから。
(HANA)
>間違って入力していた場合は >どうするんですか？ 人的ミスを無くすために私が入力して プリントアウトし 本社からのデ−タと照らし合わせ 確認欄に一つずつチェックをして 上司が更に確認して印をもらい 各部署へ配布しています。
>ってのは、どの様な物がどれくらい有るのでしょう？ 10箇所の納入先がありまが 日によって違いますが 一日4から7ぐらいです。 >また、どの様に判断するのでしょう？ ロット番号がありません。
助言ありがとうございます。 今は、プリントアウトした用紙をファイルとして保存そして 私なりにパソコンに保存しています。
（みこ）
確かに、色々な人の目を通ると 間違いに気づくかもしれませんが こう言う時の人の目って なかなか信用出来ませんからね。
＞＞その他シートを作成しておくのが良いと思いますが。 どうでしょう？
＞＞また、どの様に判断するのでしょう？ ＞ロット番号がありません。 でしたら、その列の状態も 確認すると良いかもしれませんね。
(HANA)
>なかなか信用出来ませんからね。 たしかに100%ノ−ミスはありえませんから 今のところはありませんが 今後ありえます。
＞＞＞その他シートを作成しておくのが良いと思いますが。 たとえば どのように???
ロット番号の確認もしています。
もし、白紙または削除できるものなら I列は入力規則のリストになっているので I列の納入先を空白にしたら その行が白紙または削除できないかとおもいまして。。
（みこ）
＞I列の納入先を空白にしたら ＞その行が白紙または削除できないかとおもいまして。。
あれ？急に話しが分からなくなりました。
転記をする段階で I列に入力されているシートにデータを転記するが ロット番号が無い行は転記しない。 （I列に入力が有っても、無くても） って事かと思っていたのですが なんだか違うみたいですね？？
(HANA)
HANAさん かき乱してすいません。 >I列に入力されているシートにデータを転記するが >ロット番号が無い行は転記しない。 > （I列に入力が有っても、無くても） > って事かと思っていたのですが その通りです。
「行目は転記出来ません。」
の表示がでたら もう一度、メッセ−ジが出て 「削除してもよいですか」 OKを押すと 削除される なんて できれば よいのですが
（みこ）
MsgBox i & " 行目は転記出来ません。" & vbLf & _
"I" & i & " セルの値 （" & Range("I" & i).Value & "） を確認して下さい。"
Selection.Delete Shift:=xlUp
こんな風に入れてみましたが 単純すぎますね(笑)
（みこ）
因みに、ロット番号は何列なんですか？
それから ロット番号に入力が無い状態と I列に入力が無い状態では どちらが優先されるのですか？
それとも、等しい関係に有るのでしょうか？ ロット番号に入力が無い行は必ずI列にも入力が無い と言った感じで？？
＞こんな風に入れてみましたが えっと、そんな感じで良いなら上側の方こそ それでよいと思いますが。。。
入力する場所以外には 数式が入力されて居るんじゃないんですか？
(HANA)
>ロット番号は何列なんですか？ AB列に入っています。 >どちらが優先されるのですか？ 等しい関係です。 >ロット番号に入力が無い行は必ずI列にも入力が無い >と言った感じで？？ そうですが I列に納入先が入っていても ロット番号が表示されない場合あり。 前文より (I列に入力されているシートにデータを転記するが ロット番号が無い行は転記しない。) 関係なかったかな
>入力する場所以外には >数式が入力されて居るんじゃないんですか？ はい、入っています。 IFが入っています。 削除に関しては、取り入れるつもりでしたので 別表題で HANAさんに 解決していただいています。 でも問題発覚
（みこ）
＞I列に納入先が入っていても ＞ロット番号が表示されない場合あり。 って状況が有るのなら ＞＞ロット番号に入力が無い行は必ずI列にも入力が無い と言う状況と相反しますよ？
「その他」シートを一つ作って こんな感じで。
Sub その他へ()
Dim sn, mr As Date
Dim i As Long
On Error Resume Next
If ActiveSheet.Name <> "本日予定表" Then
MsgBox "本日予定表シートをアクティブにして 実行して下さい。"
Else
mr = Range("C" & Rows.Count).End(xlUp).Row
If mr < 10 Then
MsgBox "データが有りません。"
Else
For i = 10 To mr
If Range("C" & i).Value <> "" Then
If Range("AB" & i).Value <> "" Then
sn = "その他"
Else
sn = Range("I" & i).Value
If Left(sn, 2) = "東芝" Or Left(sn, 2) = "日立" Then
sn = Left(sn, 2)
End If
End If
With Sheets(sn).Range("A" & Rows.Count).End(xlUp).Offset(1)
If Err = 0 Then
.Range("A1").Value = Range("C4").Value
.Range("C1").Value = Range("G" & i).Value
.Range("J1").Value = Range("D" & i).Value
.Range("I1").Value = Range("L" & i).Value
.Range("K1").Value = Range("AC" & i).Value
.Range("L1").Value = Range("AD" & i).Value
.Range("M1").Value = Range("AE" & i).Value
.Range("N1").Value = Range("AF" & i).Value
.Range("O1").Value = Range("AG" & i).Value
.Range("P1").Value = Range("AH" & i).Value
.Range("R1").Value = Range("AI" & i).Value
.Range("S1").Value = Range("AJ" & i).Value
.Range("T1").Value = Range("AK" & i).Value
.Range("U1").Value = Range("AL" & i).Value
.Range("V1").Value = Range("AM" & i).Value
.Range("W1").Value = Range("AN" & i).Value
.Range("X1").Value = Range("AO" & i).Value
If sn = "東芝" Or sn = "日立" Then
.Range("BB1").Value = Range("I" & i).Value
End If
Range("D" & i & ":G" & i).ClearContents
Range("I" & i).ClearContents
Range("L" & i & ":N" & i).ClearContents
Range("AJ" & i).ClearContents
Range("AC" & i & ":AO" & i).ClearContents
Else
If MsgBox(i & "行目は転記出来ません。" & vbCrLf & _
"続けて処理しますか？", vbYesNo) = vbNo Then
Exit For
End If
Err = 0
End If
End With
End If
Next
End If
End If
End Sub
↑動かして無いので、動くかどうかは分かりません。
(HANA)
＞＞＞ロット番号に入力が無い行は必ずI列にも入力が無い と言う状況と相反しますよ？ そこが返答しにくかったのですが I列の納入先でロット番号表示と I列の納入先でロット番号非表示(必要ないから) があります。
コ−ドを検証してみました。 その他のシ−トを作り 前のコ−ドを削除して貼り付け ○△◇部分だけ変更しました。 実行させると 「行目は転記出来ません。続けて処理しますか？」 の表示が出てしまいます。
[ステップイン実行]でコードの動きを確認してみました。
Dim sn, mr As Date
Dim i As Long
> On Error Resume Next
> If ActiveSheet.Name <> "本日予定表" Then
MsgBox "本日予定表シートをアクティブにして 実行して下さい。"
> Else
> mr = Range("C" & Rows.Count).End(xlUp).Row
> If mr < 10 Then
MsgBox "データが有りません。"
> Else
> For i = 10 To mr
> If Range("C" & i).Value <> "" Then
>If Range("AB" & i).Value <> "" Then
> sn = "その他"
Else
sn = Range("I" & i).Value
If Left(sn, 2) = "東芝" Or Left(sn, 2) = "日立" Then
sn = Left(sn, 2)
End If
> End If
> With Sheets(sn).Range("A" & Rows.Count).End(xlUp).Offset(1)
> If Err = 0 Then
.Range("A1").Value = Range("C4").Value
.Range("C1").Value = Range("G" & i).Value
.Range("J1").Value = Range("D" & i).Value
.Range("I1").Value = Range("L" & i).Value
.Range("K1").Value = Range("AC" & i).Value
.Range("L1").Value = Range("AD" & i).Value
.Range("M1").Value = Range("AE" & i).Value
.Range("N1").Value = Range("AF" & i).Value
.Range("O1").Value = Range("AG" & i).Value
.Range("P1").Value = Range("AH" & i).Value
.Range("R1").Value = Range("AI" & i).Value
.Range("S1").Value = Range("AJ" & i).Value
.Range("T1").Value = Range("AK" & i).Value
.Range("U1").Value = Range("AL" & i).Value
.Range("V1").Value = Range("AM" & i).Value
.Range("W1").Value = Range("AN" & i).Value
.Range("X1").Value = Range("AO" & i).Value
If sn = "東芝" Or sn = "日立" Then
.Range("BB1").Value = Range("I" & i).Value
End If
Range("D" & i & ":G" & i).ClearContents
Range("I" & i).ClearContents
Range("L" & i & ":N" & i).ClearContents
Range("AJ" & i).ClearContents
Range("AC" & i & ":AO" & i).ClearContents
>Else
If MsgBox(i & "行目は転記出来ません。" & vbCrLf & _
"続けて処理しますか？", vbYesNo) = vbNo Then
Exit For
End If
Err = 0
End If
End With
End If
Next
End If
End If
End Sub
（みこ）
＞○△◇部分だけ変更しました。 がちょっとどうなっているのかよく分かりません。
＞[ステップイン実行]でコードの動きを確認してみました。 それで、どうだったんですか？
＞「行目は転記出来ません。続けて処理しますか？」 何行目が転記出来ないと出るのですか？ また、その行の AB列とI列の値はどうなっているのですか？
(HANA)
＞＞○△◇部分だけ変更しました。 ＞ がちょっとどうなっているのかよく分かりません。
If Left(sn, 5) = "東芝○△◇" Or Left(sn, 5) = "日立○△◇" Then
sn = Left(sn, 5)
If sn = "東芝○△◇" Or sn = "日立○△◇" Then に変えています。
＞＞[ステップイン実行]でコードの動きを確認してみました。
＞それで、どうだったんですか？
sn = "その他"
から
「行目は転記出来ません。続けて処理しますか？」
OKで
Else
sn = Range("I" & i).Value
If Left(sn, 5) = "東芝○△◇" Or Left(sn, 5) = "日立○△◇" Then
へ進みます。
>何行目が転記出来ないと出るのですか？ 10,11行はロット表示で 12,13,14行はロット非表示なのに 13行目が転記出来ないと出でます。
表示てきには 12行目が転記出来ない 表示があっているのですが。
（みこ）
もう一度確認させて下さい。
表示されるメッセージは （複数回表示される場合 一番始めに表示される物） 「13行目が転記出来ない」 ですか？
その時、sn の値は何に成っていますか？
(HANA)
A,C列になにも入れない状態で 実行していました。 私のミスです。 転記しました その他へも転記しました。
（みこ）
ん〜〜〜。
A列はどうなっていても関係無いですし
C列に入力が無い行は
If Range("C" & i).Value <> "" Then
で飛ばされるんですけどね。。。
12行目は 飛ばされるから、残ってた って事かな？
でも、13行目にメッセージが出るのは変ですね。 13行目は C13,AB13に入力が有って、I13に入力がない って状態だったのかな？
まぁ、ステップインで実行すると sn に 何の値が入っているか確認出来ますね？ iの値も何に成っているか確認出来ますね？
その時に、i行目の状態を見て 本来、sn には何が入っていて欲しいのか。 それが、現在どの様に成っているのか。 では、何故その様に成るのか。 （分岐して欲しい場所へ分岐しない とか 確認しているセルの値がどうも違う様だ とか） と順を追って調べていって下さい。
ステップインで実行したら エクセルが自動でみこさんの思う様なコードに 修正してくれるわけではありません。
一行ずつ エクセルがどの様に動いているのか確認して どこで想定と違う動きをしているのか見つけるために行います。 そして、希望する動きをしてくれない場合は みこさんが、コードを修正していく必要が有ります。
(HANA)
私のミスです。 色々考えていただき 申し訳ありませんでした。
余談 別にファイルを設けて 転記できるかなと 変えてみたけど
If Range("AB" & i).Value <> "" Then
sn = "C:\My Documents\テスト111\転記"
同じブックでないと 転記しないのですね。
（みこ）
＞同じブックでないと ＞転記しないのですね。
それは変更の仕方が違うからですね。
(HANA)
ありがとうございます。
転記しない(ロット番号なし) の行の白紙または削除は どのようしたらよいのでしょうか?
（みこ）
あ、間違えました。
If Range("AB" & i).Value = "" Then
sn = "その他"
Else
として、ロット番号が無い行を その他シートへ転記。
ですね。
でも、<>"" としているコードの動きで良いんですか？
If Range("AB" & i).Value <> "" Then
sn = "その他"
Else
だとロット番号が有る行は「その他」シートへ
転記されて仕舞ってるのではないかと思いますが。
(HANA)
検証してみました。 どちらも ロットのない行は とばないです。
この場合だと
ロットのある行は指定した場所へ飛びます。
If Range("AB" & i).Value = "" Then
sn = "その他"
Else
この場合だと
ロットのある行はその他へ飛びます。
If Range("AB" & i).Value <> "" Then
sn = "その他"
Else
（みこ）
>「その他」にデ−タを残すことができました。 >ありがとうございます。 >転記しない(ロット番号なし) >の行の白紙または削除は >どのようしたらよいのでしょうか?
この時点での確認が 確認不足でした。 申し訳ありません。 「その他」シ−トしか見ていなくて 転記したもだと思ってしまいました。
（みこ）
＞この場合だと ＞ロットのある行は指定した場所へ飛びます。 この状態のコードを使ってもらうと ロットの無い行は「その他」シートへ行きませんか？ で、データも削除されると思いますが・・・・。
＞If Range("AB" & i).Value = "" Then
＞sn = "その他"
＞Else
のコードを使ってロットのない行を処理するときは この場所でどこへ分岐しますか？ また、snの値はどうなりますか？
(HANA)
>ロットの無い行は「その他」シートへ行きませんか？ 行きません。 ロットのある行は指定した場所へ飛んだ後、 ロットのない行で 「行目は転記出来ません。続けて処理しますか？」 表示が出るだけです。
>snの値は その他です
>この場所でどこへ分岐しますか？
End If
With Sheets(sn).Range("A" & Rows.Count).End(xlUp).Offset(1)
へ移行します。
（みこ）
飛ばない訳がわかりました。 AB列にはIF式が入っています。 IF式を削除したら その他へとびました。
（みこ）
AB列にはIFは必要なので
転記する時点で
ロットのない納入先の
I列を空白にして
飛ばすようにしました。
If Range("I" & i).Value = "" Then
sn = "その他"
これしか
方法がみつかりません。
（みこ）
せっかく HANAさんが「その他」へ転記できるようにしてくれたので 納入先も転記したいのですが 式がなく空白判定する欄がない 現状にて 良い知恵はないでしょうか
（みこ）
えっと、AB列に入っている式を教えて下さい。（汗）
(HANA)
AB列には、
AB10,AB11,AB12〜
=IF(I10="","",INDEX(Q10:U10,MATCH(IF(LEFT(I10,LEN(Q$8))=Q$8,Q$8,LEFT(I10,FIND("，",I10&"，")-1)),Q$8:U$8,0)))
=IF(I11="","",INDEX(Q11:U11,MATCH(IF(LEFT(I11,LEN(Q$8))=Q$8,Q$8,LEFT(I11,FIND("，",I11&"，")- 1)),Q$8:U$8,0)))
=IF(I12="","",INDEX(Q12:U12,MATCH(IF(LEFT(I12,LEN(Q$8))=Q$8,Q$8,LEFT(I12,FIND("，",I12&"，")-1)),Q$8:U$8,0)))
と入っています。
（みこ）
ん〜。 AB列はロット番号なんですよね・・・？
サンプルデータを作るのは大変だとは思いますが こちらでシートが作れるだけの情報を 載せてもらえませんか？
(HANA)
>AB列はロット番号なんですよね・・・？ そうです。 HANAさん、現在ロット番号の不具合もあり 転記の件が終了したら お聞きしょうと思っていました。 ロットのスレのほうが サンプルデータが豊富なので 一度 こちらを閉じて ロットのスレを立ち上げても よろしいでしょうか?
（みこ）
・Q2:S6が、納入先と対応ロット番号 ・ I列に、納入先 ・Q8:U8に作業列の納入先 =INDEX($Q$2:$Q$6,COLUMN(A2)) ↓ =INDEX($Q$2:$Q$6,COLUMN(E2))
・Q9:U9に、前回の最後のロット番号を入力
P列
=IF(RIGHT(I10,1)="2","",IF(RIGHT(I10,1)="1",LEFT(I10,FIND("，",I10&"，")-1),IF(LEFT(I10,LEN (Q$8))=Q$8,Q$8,I10)))
Q列 =IF($P10=Q$8,IF((SUMPRODUCT(($A$10:$A19=$A10)*($P$10:$P19=$P10))-SUMPRODUCT(($A$9:$A9=$A10)*($P$9:$P9=$P10))+OFFSET(Q10,-1,))>VLOOKUP(Q$8,$Q$2:$S$6,3,FALSE),VLOOKUP(Q$8,$Q$2:$S$6,2,FALSE), OFFSET(Q10,-1,)+1), OFFSET(Q10,-1,))
R列 =IF($P10=R$8,IF((SUMPRODUCT(($A$10:$A19=$A10)*($P$10:$P19=$P10))-SUMPRODUCT(($A$9:$A9=$A10)*($P$9:$P9=$P10))+OFFSET(R10,-1,))>VLOOKUP(R$8,$Q$2:$S$6,3,FALSE),VLOOKUP(R$8,$Q$2:$S$6,2,FALSE), OFFSET(R10,-1,)+1), OFFSET(R10,-1,))
S列 =IF($P10=S$8,IF((SUMPRODUCT(($A$10:$A19=$A10)*($P$10:$P19=$P10))-SUMPRODUCT(($A$9:$A9=$A10)*($P$9:$P9=$P10))+OFFSET(S10,-1,))>VLOOKUP(S$8,$Q$2:$S$6,3,FALSE),VLOOKUP(S$8,$Q$2:$S$6,2,FALSE), OFFSET(S10,-1,)+1), OFFSET(S10,-1,))
T列 =IF($P10=T$8,IF((SUMPRODUCT(($A$10:$A19=$A10)*($P$10:$P19=$P10))-SUMPRODUCT(($A$9:$A9=$A10)*($P$9:$P9=$P10))+OFFSET(T10,-1,))>VLOOKUP(T$8,$Q$2:$S$6,3,FALSE),VLOOKUP(T$8,$Q$2:$S$6,2,FALSE), OFFSET(T10,-1,)+1), OFFSET(T10,-1,))
U列 =IF($P10=U$8,IF((SUMPRODUCT(($A$10:$A19=$A10)*($P$10:$P19=$P10))-SUMPRODUCT(($A$9:$A9=$A10)*($P$9:$P9=$P10))+OFFSET(U10,-1,))>VLOOKUP(U$8,$Q$2:$S$6,3,FALSE),VLOOKUP(U$8,$Q$2:$S$6,2,FALSE), OFFSET(U10,-1,)+1), OFFSET(U10,-1,))
AB列
=IF(I10="","",INDEX(Q10:U10,MATCH(IF(LEFT(I10,LEN(Q$8))=Q$8,Q$8,LEFT(I10,FIND("，",I10&"，")-1)),Q$8:U$8,0)))
こんな感じで入っています。
（みこ）
えっと、数式を教えてもらっただけでは シートは出来ないんですね。。。
と言うか、これってもしかして 転記が終わった所からデータを消していったら 根拠となる数字が変わっていくので 転記されたデータは、転記したかったデータと異なる可能性がある なんて事は無いですか？
＞こちらを閉じて ＞ロットのスレを立ち上げても ＞よろしいでしょうか? そうですね。 それぞれ個別に作るのではなく 両方を考えながら作っていった方が良いかもしれません。
(HANA)
>転記されたデータは、転記したかったデータと異なる可能性がある >なんて事は無いですか？ 予定表の空白欄に入力して 転記 各シ−トの空白欄に飛んでいきます。 この時点では問題ないのですが ロットが関係してきます。 ロットに関しては、予定表のロットと各シ−トのロット にそれぞれ式を入れてありますから 問題ないです。 検証済み 予定表のロットの不具合が生じまして ロットのレスを立ち上げさせていただきます。
（みこ）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.