ここから本文です

併用しているマクロがあるのですが、前提0よりはと失礼ながら続質問させていただき...

gol********さん

2018/9/1823:57:59

併用しているマクロがあるのですが、前提0よりはと失礼ながら続質問させていただきました。

売掛シート 契約者セル選択時にて呼ぶマクロです。

こちらもアクティブセルより担当者が書かれている、住所右備考2段目セルが新規シートO3(担当者)と同じだった場合に担当シートにも併せて入力させたいのですが、前回のように全てをコピペしてしまうと担当シートで重複が発生してしまうため、
売掛シートのActiveCell.Offset(3, 1)担当者が新規シートO3と同じだった場合、
売掛シートのActiveCell(契約者名)を担当シートA列より見つけ、見つけたセルをアクティブセルとして併記入できませんでしょうか?


Private Sub CommandButton1_Click()

Dim r As Range, tr As Range, flg As Boolean

If ListBox2.ListIndex < 0 Then Exit Sub

ActiveCell.Activate

flg = False
Set tr = ActiveCell.Offset(0, 2).Resize(6, 1)

For Each r In tr

With ListBox2
If r.Value = "" Then
r.NumberFormat = "yyyy/m/d"
r.Value = .List(.ListIndex, 3)
r.Offset(0, 1).Value = .List(.ListIndex, 2)
flg = True
Exit For
End If
End With

Next r

If Not flg Then MsgBox "入力または選択を見直して下さい。", vbExclamation, "入力欄オーバー"

End Sub

With ListBox2,If r.Value,flg As Boolean,0 Then Exit Sub,Dim r As Range,If Not flg Then,r.NumberFormat

この質問は、vcx********さんに回答をリクエストしました。

閲覧数:
49
回答数:
1
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

vcx********さん

リクエストマッチ

2018/9/1912:32:37

goldswallow3040さん

先の質問でこの画像は見たことあるなぁ、、、と思ってましたが、今回提示されたコードで完全に一致しました。

goldswallow_stageさん、if_verityさんですね。
貴方とは当時のやり取りで苦い思い出があるため、上手く行っても行かなくても回答はこれっきりとさせてもらいます。

---

正直言ってデータ構造や運用がまったく理解出来ません。

契約者に同姓同名は絶対に存在しえないのか?
(これがあったら処理は破綻する)

提示されたコードは「支払日」「支払額」を入力するものと推測しますが入力可能欄は5行しかなく、5行を超えたら同じ契約者で売掛帳簿のデータが作られる事は無いのか?
(これがあったら担当者側は6行目以降反映されない)

「新規シートO3(担当者)と同じだった場合に担当シートにも併せて入力」とは、裏を返せば「違っていたら転記しない」と言う事であり、処理したのが別の人物なら担当者側のデータは抜けても良いのか?
(売掛帳簿と担当者側でデータ内容に相違が起こる)

などなど疑問は絶えませんが、質問から推測した通りにコードをおこすと以下の通りです。
上手く行かなくても修正対応はしませんのでご理解下さい。


Private Sub CommandButton1_Click()
Dim r As Range, tr As Range, fr As Range, flg As Boolean

If ListBox2.ListIndex < 0 Then Exit Sub

ActiveCell.Activate

flg = False
Set tr = ActiveCell.Offset(0, 2).Resize(6, 1)

For Each r In tr

With ListBox2
If r.Value = "" Then
r.NumberFormat = "yyyy/m/d"
r.Value = .List(.ListIndex, 3)
r.Offset(0, 1).Value = .List(.ListIndex, 2)
flg = True
Exit For
End If
End With

Next r

If Not flg Then
MsgBox "入力または選択を見直して下さい。", vbExclamation, "売掛帳簿 入力欄オーバー"
Exit Sub
End If

If Worksheets("新規顧客").Range("O3").Value = _
ActiveCell.Offset(3, 1).Value Then
flg = False

Set fr = Worksheets("担当者").Columns(1).Find _
(what:=ActiveCell.Value, LookIn:=xlValues, lookat:=xlWhole)

If Not fr Is Nothing Then
Set tr = fr.Offset(0, 2).Resize(6, 1)
For Each r In tr
With ListBox2
If r.Value = "" Then
r.NumberFormat = "yyyy/m/d"
r.Value = .List(.ListIndex, 3)
r.Offset(0, 1).Value = .List(.ListIndex, 2)
flg = True
Exit For
End If
End With
Next r
End If

If Not flg Then
MsgBox "担当者シートへは転記出来ませんでした。", vbCritical, "担当者 入力欄オーバー"
End If

End If

End Sub

  • 質問者

    gol********さん

    2018/9/1912:57:00

    数年前の同じ方だったんですね
    かしこまりました
    あと、別質問の250チケットも前回回答と同じなのでなにか入力してもらえればBAします。

  • その他の返信(1件)を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2018/9/19 13:21:34

ヘルプを見ても理解できないのですが、ご迷惑をおかけしていたようで、
自重するように努力します。ありがとうございました!

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる