次の3項目のフォームがあります。
"番号"
"お店"
"分類"
これら項目に入力した値からシートデータベースの情報をリストボックスに表示させているのですが、"分類"にあるABCDEの情報のうちDの情報を省いて表示させたいのですがわかりません。
省く指定はチェックボックスを考えています。
ご教授よろしくお願いいたします。
↓コード
Private Sub SetListBox()
Dim wRow As Long
Dim wLstRow As Long
Dim wHitFlg As Boolean
Me.lst顧客リスト.Clear
wLstRow = 0
With Worksheets("顧客情報")
For wRow = 2 To .Range("A1").CurrentRegion.Rows.Count
wHitFlg = True
If Me.txt顧客名 <> "" Then
If InStr(1, .Cells(wRow, .Range("顧客名列").Column), Me.txt顧客名, vbTextCompare) = 0 Then
wHitFlg = False
End If
End If
If Me.cmb顧客分類 <> "" Then
If .Cells(wRow, .Range("顧客分類列").Column) <> Me.cmb顧客分類 Then
wHitFlg = False
End If
End If
If Me.TextBox1 <> "" Then
If InStr(1, .Cells(wRow, .Range("フリガナ列").Column), Me.TextBox1, vbTextCompare) = 0 Then
wHitFlg = False
End If
End If
If wHitFlg = True Then
Me.lst顧客リスト.AddItem ""
Me.lst顧客リスト.List(wLstRow, 0) = wRow
Me.lst顧客リスト.List(wLstRow, 1) = Worksheets("顧客情報").Cells(wRow, 2)
Me.lst顧客リスト.List(wLstRow, 2) = Worksheets("顧客情報").Cells(wRow, 3)
Me.lst顧客リスト.List(wLstRow, 3) = Worksheets("顧客情報").Cells(wRow, 8)
wLstRow = wLstRow + 1
End If
Next
End With
現在下記のようなコードで
ユーザーフォームのリストボックスで表示されている
項目を選択した状態でボタンを押すと
選択されているセルのアドレスを取得するコードを組んでいます。
リストボックスに表示されている（一番左側）番号が
重複していなければ正しく機能するのですが
重複していると、上の方が優先されてしまい
下のリストを選択している状態でコードを実行しても
上のセルのアドレスが表示されてしまいます。
リストの一番左側の番号が重複しているとき
左から２番目の日付と時間の項目（添付画像を参照）を対象にして
正しくセルのアドレスを取得していです。
もし今回のコードのようなやり方でなくても
単純にリストボックスにで選択状態になっているセルアドレスを調べられればそれでもいいです。
Private Sub CommandButton2_Click()
Dim ss As String
ss = ListBox1.Text
If ss <> "" Then
Dim r As Range, s As Range
Set s = Range(ListBox1.RowSource)
Set r = s.Find(ss, LookAt:=xlWhole)
If Not r Is Nothing Then
MsgBox r.Address(RowAbsolute:=False, ColumnAbsolute:=False)
End If
End If
End Sub
次の3項目のフォームがあります。
"番号"
"お店"
"分類"
これら項目に入力した値からシートデータベースの情報をリストボックスに表示させているのですが、"分類"にあるABCDEの情報のうちDの情報を省いて表示させたいのですがわかりません。
省く指定はチェックボックスを考えています。
ご教授よろしくお願いいたします。
↓コード
Private Sub SetListBox()
Dim wRow As Long
Dim wLstRow As Long
Dim wHitFlg As Boolean
Me.lst顧客リスト.Clear
wLstRow = 0
With Worksheets("顧客情報")
For wRow = 2 To .Range("A1").CurrentRegion.Rows.Count
wHitFlg = True
If Me.txt顧客名 <> "" Then
If InStr(1, .Cells(wRow, .Range("顧客名列").Column), Me.txt顧客名, vbTextCompare) = 0 Then
wHitFlg = False
End If
End If
If Me.cmb顧客分類 <> "" Then
If .Cells(wRow, .Range("顧客分類列").Column) <> Me.cmb顧客分類 Then
wHitFlg = False
End If
End If
If Me.TextBox1 <> "" Then
If InStr(1, .Cells(wRow, .Range("フリガナ列").Column), Me.TextBox1, vbTextCompare) = 0 Then
wHitFlg = False
End If
End If
If wHitFlg = True Then
Me.lst顧客リスト.AddItem ""
Me.lst顧客リスト.List(wLstRow, 0) = wRow
Me.lst顧客リスト.List(wLstRow, 1) = Worksheets("顧客情報").Cells(wRow, 2)
Me.lst顧客リスト.List(wLstRow, 2) = Worksheets("顧客情報").Cells(wRow, 3)
Me.lst顧客リスト.List(wLstRow, 3) = Worksheets("顧客情報").Cells(wRow, 8)
wLstRow = wLstRow + 1
End If
Next
End With
次の3項目のフォームがあります。
"番号"
"お店"
"分類"
これら項目に入力した値からシートデータベースの情報をリストボックスに表示させているのですが、"分類"にあるABCDEの情報のうちDの情報を省いて表示させたいのですがわかりません。
省く指定はチェックボックスを考えています。
ご教授よろしくお願いいたします。
↓コード
Private Sub SetListBox()
Dim wRow As Long
Dim wLstRow As Long
Dim wHitFlg As Boolean
Me.lst顧客リスト.Clear
wLstRow = 0
With Worksheets("顧客情報")
For wRow = 2 To .Range("A1").CurrentRegion.Rows.Count
wHitFlg = True
If Me.txt顧客名 <> "" Then
If InStr(1, .Cells(wRow, .Range("顧客名列").Column), Me.txt顧客名, vbTextCompare) = 0 Then
wHitFlg = False
End If
End If
If Me.cmb顧客分類 <> "" Then
If .Cells(wRow, .Range("顧客分類列").Column) <> Me.cmb顧客分類 Then
wHitFlg = False
End If
End If
If Me.TextBox1 <> "" Then
If InStr(1, .Cells(wRow, .Range("フリガナ列").Column), Me.TextBox1, vbTextCompare) = 0 Then
wHitFlg = False
End If
End If
If wHitFlg = True Then
Me.lst顧客リスト.AddItem ""
Me.lst顧客リスト.List(wLstRow, 0) = wRow
Me.lst顧客リスト.List(wLstRow, 1) = Worksheets("顧客情報").Cells(wRow, 2)
Me.lst顧客リスト.List(wLstRow, 2) = Worksheets("顧客情報").Cells(wRow, 3)
Me.lst顧客リスト.List(wLstRow, 3) = Worksheets("顧客情報").Cells(wRow, 8)
wLstRow = wLstRow + 1
End If
Next
End With
マクロの初心者です。Dim で宣言してやりたいと思っています。
既存のExcelの機能で出来ないことはないと思いますが、敢えて、マクロででないか。
やってみたいと思っています。
やりたいこと等について
1 sheet１のE2:J1109の範囲のデータをコピーしての別sheet２のE3:J1110の範囲に貼り付けたい。
２ その時に最終行を取得してコピーをするとしたら、どんなコードが必要なのか
３ 最終行の取得のコードの書き方が分からない
４ ネットで下記のような(一部変更)に作ってみたが、これで良いのでしょうか、わからない。
以上のことを答えて頂けませんか。よろしくお願いします。
Sub テスト()
Dim range1 As Range
Set range1 = Range("E2:J1109")
range1.Copy
ActiveSheet.Paste Destination:=("sheet１").Range("E2:J1109")
ActiveSheet.Paste Destination:=("sheet2").Range("E3:J1110")
Application.CutCopyMode = False
End Sub
Excelのマクロ記述についての質問です．
以下のマクロはエクセルにない関数「IMMULT」をあらかじめ定義するためのものです．（技術計算のHPより入手し，コピーして貼り付けたものです）
これを実行すると「End Subがみつからない」と出てしまいます．End Subは記述しているのになぜでしょうか，どなたか解決策を教えて頂けませんか！
Sub 関数定義()
Public Function IMMULT(a As Range, b As Range) As Variant
Dim r1 As Integer, r2 As Integer, c1 As Integer, c2 As Integer, nn As Integer
Dim r As Integer, c As Integer
Dim cr As Integer, cc As Integer
Dim n As Integer
Dim mm() As Variant
r1 = a.Rows.Count
r2 = b.Rows.Count
c1 = a.Columns.Count
c2 = b.Columns.Count
If (c1 = r2) Then nn = c1 Else Exit Function
End If
cr = r1
cc = c2
ReDim mm(1 To cr, 1 To cc)
For r = 1 To cr
For c = 1 To cc
mm(r, c) = 0
For n = 1 To nn
mm(r, c) = IMSUMa(mm(r, c), IMPRODUCTa(a.Cells(r, n), b.Cells(n, c)))
Next
Next
Next
IMMULT = mm
End Sub
Excelのマクロ記述についての質問です．
以下のマクロはエクセルにない関数「IMMULT」をあらかじめ定義するためのものです．（技術計算のHPより入手し，コピーして貼り付けたものです）
これを実行すると「End Subがみつからない」と出てしまいます．End Subは記述しているのになぜでしょうか，どなたか解決策を教えて頂けませんか！
Sub 関数定義()
Public Function IMMULT(a As Range, b As Range) As Variant
Dim r1 As Integer, r2 As Integer, c1 As Integer, c2 As Integer, nn As Integer
Dim r As Integer, c As Integer
Dim cr As Integer, cc As Integer
Dim n As Integer
Dim mm() As Variant
r1 = a.Rows.Count
r2 = b.Rows.Count
c1 = a.Columns.Count
c2 = b.Columns.Count
If (c1 = r2) Then nn = c1 Else Exit Function
End If
cr = r1
cc = c2
ReDim mm(1 To cr, 1 To cc)
For r = 1 To cr
For c = 1 To cc
mm(r, c) = 0
For n = 1 To nn
mm(r, c) = IMSUMa(mm(r, c), IMPRODUCTa(a.Cells(r, n), b.Cells(n, c)))
Next
Next
Next
IMMULT = mm
End Sub
マクロの初心者です。Dim で宣言してやりたいと思っています。
既存のExcelの機能で出来ないことはないと思いますが、敢えて、マクロででないか。
やってみたいと思っています。
やりたいこと等について
1 sheet１のE2:J1109の範囲のデータをコピーしての別sheet２のE3:J1110の範囲に貼り付けたい。
２ その時に最終行を取得してコピーをするとしたら、どんなコードが必要なのか
３ 最終行の取得のコードの書き方が分からない
４ ネットで下記のような(一部変更)に作ってみたが、これで良いのでしょうか、わからない。
以上のことを答えて頂けませんか。よろしくお願いします。
Sub テスト()
Dim range1 As Range
Set range1 = Range("E2:J1109")
range1.Copy
ActiveSheet.Paste Destination:=("sheet１").Range("E2:J1109")
ActiveSheet.Paste Destination:=("sheet2").Range("E3:J1110")
Application.CutCopyMode = False
End Sub
A列:E列のセルデータがあって、空欄を省いて、コピペでるようにしたのでが、新たに、D列を最初にソート、後からB列・C列を連動させてソートしたいのですが、うまく処理できません。ご教授願えませんか。Sheets("ZZZZZZZ")のデータは１行おきのようなデータです。コピペまではできていますが、その後のソートについてお願いします。
Sub Macro1()
Application.ScreenUpdating = False
Dim Rng As Range
Dim LastRow As Long
'●ここをだけ"B2:B100"指定する
For Each Rng In Sheets("ZZZZZZZ").Range("B2:B100")
If Rng.Value <> "" Then
LastRow = Sheets("QQQQQQQQ").Cells(Rows.Count, "B").End(xlUp).Row
Sheets("QQQQQQQQ").Cells(LastRow + 1, "B").Resize(1, 3).Value = Rng.Resize(1, 3).Value
End If
Next Rng
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
マクロの説明
１．Sub Sample7()はsheet４の列をソートするマクロです。
(単独では、このマクロでソートできる)
２．Sub sample2()はsheet４のソート以外は完成しています。
やりたいこと
Sub sample2()の中にsheet４の重複データを削除したもののソートのコードを組み込みたい。
但し、組み込むとしてSub Sample7()のコードでよいのか、初心者なのでよくわかりません。
なお、Sub sample2()のマクロは途中省いています。
Sub Sample7()
Sheets("sheet4").Range("A1:A1135").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
End Sub
Sub sample2()
Dim data As Variant 'データコピー用の使いまわし配列
Dim dic As Object
Dim i As Long
Set dic = CreateObject("Scripting.Dictionary")
'Sheet4～5のA列をリセット
Sheets("Sheet4").Range("A2:A" & Rows.Count).ClearContents
Sheets("Sheet5").Range("C3:C" & Rows.Count).ClearContents
↓↓↓↓↓↓↓↓↓↓↓↓↓↓
'Sheet4に重複していないデータを書き込み
With Sheets("Sheet4")
.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(dic.Count).Value = Application.Transpose(dic.keys)
'Sheet4のC列をSheet5にコピー
data = .Range("C2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
End With
Sheets("Sheet5").Range("C3").Resize(UBound(data)).Value = data
Set dic = Nothing
End Sub
