Excel VBA質問箱 IV

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

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


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

24482 / 76732

←次へ　｜　前へ→


	【57598】Re:検索して分岐

kanabun - 08/9/3(水) 22:19 -


	引用なし

	パスワード

▼M さん：

考えてみれば、cboKaishaのChangeで cboTantouの担当者リストをつくるとき、
いっしょに CN請求書番号もcboTantouのリストに表示しておけば（下へつづく）
▼
Private Sub cboKaisha_Change()
　Dim cc As Range
　Dim ss As String, i As Long
　Dim vTantou, vCN, numCN
　Dim dic As Object
　
　With Worksheets("ＡＡＡ")
　　　Application.ScreenUpdating = False
　　　.AutoFilterMode = False
　　　With .Range("B1", .Range("B65536").End(xlUp))
　　　　　.AutoFilter 1, cboKaisha.Text
　　　　　On Error Resume Next
　　　　　Set cc = Intersect(.Offset(, 1), .Offset(1, 1))
　　　　　On Error GoTo 0
　　　　　If cc Is Nothing Then
　　　　　　　cboTantou.Clear
　　　　　　　cboTantou.Text = ""
　　　　　Else
　　　　　　　cc.Copy
　　　　　　　With New DataObject '選択された「取引会社」の全担当者をリスト
　　　　　　　　　.GetFromClipboard
　　　　　　　　　ss = .GetText
　　　　　　　　　vTantou = Split(ss, vbCrLf)
　　　　　　　　　.Clear
　　　　　　　　　　　　　　　　　'同時に担当者の最終CN番号を表示
　　　　　　　　　cc.Offset(, 5).Copy
　　　　　　　　　.GetFromClipboard
　　　　　　　　　ss = .GetText
　　　　　　　　　vCN = Split(ss, vbCrLf)
　　　　　　　End With
　　　　　　　Application.CutCopyMode = False
　　　　　　　Set dic = CreateObject("Scripting.Dictionary")
　　　　　　　For i = 0 To UBound(vTantou) - 1
　　　　　　　　　ss = vTantou(i)
　　　　　　　　　If dic.Exists(ss) Then
　　　　　　　　　　　numCN = dic(ss)
　　　　　　　　　　　If numCN < vCN(i) Then dic(ss) = vCN(i)
　　　　　　　　　Else
　　　　　　　　　　　dic(ss) = vCN(i)
　　　　　　　　　End If
　　　　　　　Next
　　　　　　　With cboTantou
　　　　　　　　　.ColumnCount = 2
　　　　　　　　　.ListWidth = 180
　　　　　　　　　.List = Application.Transpose(Array(dic.Keys, dic.Items))
　　　　　　　End With
　　　　　　　Set dic = Nothing
　　　　　End If
　　　End With
　　　.AutoFilterMode = False
　　　Application.ScreenUpdating = True
　End With
　　
End Sub

こうしておけば、ユーザーが担当者リストのどれかを選択すると同時に、
テキストボックス txtCN に最終番号＋１が表示されますから、もう
ボタンは不要となりますね♪
▼
Private Sub cboTantou_Change()
　　Dim numCN
　　With cboTantou
　　　　numCN = .List(.ListIndex, 1)
　　End With
　　If IsNumeric(numCN) Then
　　　　txtCN.Text = numCN + 1
　　Else
　　　　txtCN.Text = "？？"
　　End If
End Sub

0 hits

▼

【57576】検索して分岐 M 08/9/3(水) 12:06