- ベストアンサー
VBAでのデータ検索に関する問題
- VBAでデータ検索を行う際、一部の該当者が表示されない問題が発生しています。
- ボタンを作成して登録した後、該当者がいるにも関わらず「該当者なし」と表示されます。
- 初心者のため、どのように修正すればよいかわかりません。アドバイスをお願いします。
- その他（ビジネス・キャリア）
- 回答数2
- ありがとう数0
- みんなの回答 （2）
- 専門家の回答
関連するQ&A
- ExcelvbaのFindNext複数項目繰り返し
Excelvba2013で、同じ検索条件で続けて検索取得していくのに、ネットで調べながらFindNextを使ってやっています。 "テーブル"シートのA列に検索したい分類項目が記載されていて、その隣のB列にデータがあります。分類項目は変動するため数は不明です。 そして、"データ"シートのC3,D3,E3・・・と分類項目が載っています。 Ｃ３の下のC4,C5,C6・・・に分類項目のC3のデータを入れていき、Ｄ3の下のD4,D5,D6・・・にD4のデータ、以降E列、F列と続いていきます。 とりあえず、現在、"データ"シートのC3の項目に対するデータは取得できています。以降、C3の項目のデータが満たされたらD3、E3・・・と"テーブル"シートのA列の分類項目をすべて満たすまで繰り返したいのですが、繰り返し処理のやり方がうまくできず、次の分類項目に進めずにいます。 以下のコードをどのように変えたらよいでしょうか？ すいません、いつもお手数をおかけしています。 Sub 同じ条件でデータ検索繰り返し2() Dim myRange As Range, srcRange As Range, myAddress As String, i As Integer, p As Integer Application.ScreenUpdating = False p = 3 Set srcRange = Worksheets("テーブル").Range("A:A") 'テーブルのA列を格納 Set myRange = srcRange.Find(What:=Worksheets("データ").Cells(3, p).Value, LookIn:=xlValues, _ LookAt:=xlWhole) If Not myRange Is Nothing Then myAddress = myRange.Address i = 4 Do Cells(i, p).Value = myRange.Offset(, 1).Value Set myRange = srcRange.FindNext(After:=myRange) i = i + 1 Loop Until myRange.Address = myAddress End If If myRange.Address = myAddress Then Do p = p + 1 Cells(i, p).Value = myRange.Offset(, 1).Value Set myRange = srcRange.FindNext(After:=myRange) i = i + 1 Loop Until myRange.Address = myAddress Else End If End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルVBA
A列を基準にBC列が空白ならAの数値を入れて、A>BならB列を更新、A<CならC列を更新 A列が数値以外ならその行をスキップ、という処理をしたいのですが Option Explicit Dim A As Range, B As Range, C As Range Dim i As Long Sub test() For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A) Then Else Exit Sub End If If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value Next i End Sub とすると数値以外の行の時点で停止してしまいます。 その行を飛ばして次の行に進むにはどうしたらいいのでしょうか？
- ベストアンサー
- Visual Basic
- エクセルVBA
Sub PlusA001() Dim a As Range Dim b As Integer Range("e1").Value = "氏名" Range("e2").Value = "甲" Range("e2").AutoFill Destination:=Range("e2:e10"), Type:=xlFillDefault Range("f1:j1").Value = Array("国", "数", "理", "社", "英") Set a = Range("f2") For i = 1 To 5 Do Until b = 9 a.Value = Int(100 * Rnd) + 1 b = b + 1 Set a = a.Offset(1, 0) Loop b = 0 Set a = a.Offset(-9, 1) Next i End Sub サンプルコードの例ですが、どうも実行しても納得できない部分があります。それはSet a=a.offset(-9,1)の部分です。Set a = Range("f2")においてf2を始点としているのは判りますが、ｆ２からであればa=a.offset（－９、５） とすればいいのかと思い実行したのですが、ぐちゃぐちゃになります。なぜ（－９、５）ではなく（－９、１）何ですか？いくら読み解いても判りません。教えてください。
- ベストアンサー
- Visual Basic
- エクセルの簡単なマクロ機能を追加したいのです
既存のエクセルマクロ（Sub チェック()以下です）に下記の内容のマクロを付け足したいです。 教えていただけないでしょうか。 付け足したい条件です： Sheet2のC列に 0 があれば Sheet1のB列に 愛 と（[太字]でセルの背景色を[灰色25%]にして）入れたいです 恐れ入りますがご存じの方がいらっしゃりましたら教えていただきたく何卒よろしくお願いいたします。 ----------------------------------------------- Sub チェック() Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim myRange1 As Range Dim myRange2 As Range Dim c1 As Range Dim c2 As Range Dim myCt As Long Set Ws1 = Worksheets("Sheet1") Set Ws2 = Worksheets("Sheet2") Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp)) Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp)) For Each c1 In myRange1 myCt = 0 For Each c2 In myRange2 If c2.Value = c1.Value Then If c2.Offset(, 1).Value = "" Then c1.Offset(, 1).Interior.ColorIndex = 3 Else c1.Offset(, 1).Value = c2.Offset(, 1).Value End If myCt = myCt + 1 End If Next c2 If myCt > 1 Then c1.Offset(, 1).Interior.ColorIndex = 10 Next c1 Set Ws1 = Nothing Set Ws2 = Nothing Set myRange1 = Nothing Set myRange2 = Nothing End Sub
- 締切済み
- その他MS Office製品
- EXCEL Spirit関数 繰り返し処理
EXCEL VBAでテキストファイルを読み込み、Spirit関数にて項目内容を書き出しています。 下記のコードの日付部分は1日～31日まで繰り返しになります。 Dim maxRow As Integer Dim maxCol As Integer Dim i As Long Dim mytxtfile As String, myStr As String Dim myRange As Range Dim mySp() As String Dim sh1 As Worksheet On Error GoTo myError mytxtfile = "D:\明細.TXT" Set sh1 = Worksheets("元データ") Set myRange = sh1.Range("A1") sh1.Cells.Clear Open mytxtfile For Input As #1 Do Until EOF(1) Line Input #1, myStr myRange.Offset(i, 0).Value = myStr myStr = Replace(myStr, """", "") mySp = Split(myStr, ",") myRange.Offset(i, 1).Value = mySp(0) '卸名 myRange.Offset(i, 2).Value = mySp(1) 'コード myRange.Offset(i, 3).Value = mySp(2) 'フラグ myRange.Offset(i, 4).Value = mySp(6) '納品先 myRange.Offset(i, 5).Value = mySp(7) '店舗 myRange.Offset(i, 6).Value = mySp(23) '日付 ---------ここから myRange.Offset(i, 7).Value = mySp(26) '1日_金額A myRange.Offset(i, 8).Value = mySp(27) '1日_金額B myRange.Offset(i, 9).Value = mySp(34) '1日_金額C --------ここまでが 1日分です。これが31日まで続きます。 i = i + 1 Loop Close #1 '31日までのデータが無い場合のエラーを無視する（データが存在する日まで書き出す） myError: Resume Next sh1.Range("A:A").Delete 'txt取込作業列を削除 End Sub カンマ区切りの位置は、15ずつ増えますので 繰り返し処理したいのですが、うまくいきません。 最初は、金額A だけの書き出しだったため、 1行ずつ書いていたのですが、金額B、Cの列も必要になりました。 for next で すっきりした書き方を教えていただけないでしょうか？ 宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- カットして隣のB列に順番にペーストするマクロ
発注と納品の確認マクロを作成しました。 Sheet1の列を検索して、Sheet2にあればその数字のあるセルを赤くするのですが、 それを以下のように変更することは可能でしょうか？ Sheet1の列を検索して、Sheet2にあれば、Sheet2上でその数字をカットして隣のB列に上から順番にペーストします。 宜しくお願いします。 Sub 発注と納品の確認マクロ() Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim myRange1 As Range Dim myRange2 As Range Dim c1 As Range Dim c2 As Range Dim myCt As Long Set Ws1 = Worksheets("Sheet1") Set Ws2 = Worksheets("Sheet2") Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp)) Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp)) For Each c1 In myRange1 myCt = 0 For Each c2 In myRange2 If c2.Value = c1.Value Then If myCt = 0 Then c2.Interior.ColorIndex = 3 Else c2.Interior.ColorIndex = 43 End If myCt = myCt + 1 End If Next c2 If myCt = 0 Then c1.Interior.ColorIndex = 6 Next c1 Set Ws1 = Nothing Set Ws2 = Nothing Set myRange1 = Nothing Set myRange2 = Nothing End Sub
- ベストアンサー
- その他MS Office製品
- エクセルVBA
エクセル2003です 勉強中です 教えてください Sheet1 A B C D 1 日付 種類 数量1 数量2 2 2月3日 C 300 10 3 2月4日 B 200 5 4 2月5日 A 100 20 5 2月3日 A 100 10 6 2月4日 B 200 5 7 2月5日 C 300 20 8 2月3日 A 300 20 9 2月4日 C 200 5 10 2月5日 B 100 10 Sheet1 F G H I 1 日付 種類 数量1 数量2 2 2月3日 A 400 3 2月3日 C 300 4 2月4日 B 600 5 2月5日 A 100 6 2月5日 C 400 7 したい事 *A列～D列のデータをF列からI列へ複数条件の集計をしたいのですが *A列～D列の数値が変動すると勝手に自動で集計をして欲しい（シートがアクティブでなくても） *下記コードでC列までの集計ができますがD列の集計がわかりません （増やそうとすると頭の中がぐちゃぐちゃになって・・・） *前回の集計が残ってしまう Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myDic As Object, myKey, myItem Dim myVal, myVal2, myVal3 Dim i As Long Range("F2", Range("I" & Rows.Count).End(xlUp)).ClearContents Range("F1:I1").Value = Range("A1:D1").Value Set myDic = CreateObject("Scripting.Dictionary") ' データを配列に格納 myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value ' myDicへデータを格納 For i = 1 To UBound(myVal, 1) myVal2 = myVal(i, 1) & "_" & myVal(i, 2) If Not myVal2 = "_" Then If Not myDic.exists(myVal2) Then myDic.Add myVal2, myVal(i, 3) Else myDic(myVal2) = myDic(myVal2) + myVal(i, 3) End If End If Next 'Key,Itemの書き出し myKey = myDic.keys myItem = myDic.items For i = 0 To UBound(myKey) myVal3 = Split(myKey(i), "_") Cells(i + 2, 6).Value = myVal3(0) Cells(i + 2, 7).Value = myVal3(1) Cells(i + 2, 8).Value = myItem(i) Next Set myDic = Nothing '並べ替え Range("F2", Range("H" & Rows.Count).End(xlUp)).Sort _ Key1:=Range("F2"), Order1:=xlAscending, _ Key2:=Range("G2"), Order2:=xlAscending, _ Header:=xlGuess End Sub 頭のなかがこんがらがってしまいます お願いです 出来れば説明付きで教えていただけませんか よろしくお願いします
- 締切済み
- オフィス系ソフト
- Excel VBA でVLookUPの質問
教えてください。 Excel VBA でVLookUPを使用したいのですが 毎回シート名も数も変わります。 そのため、検索範囲 のシート名をセル値が取得したいのですが どうすればよいでしょうか？ 検索値 = AシートB列 検索範囲=BシートM列 書出し範囲=AシートU列 下記のコード作成しましたが ws = Worksheets("②価格集計").Range("U2").Value 検索用格納配列(i, 1) = "=VLOOKUP(B" & i + 1 & ",ws!A:M,13,0)" でエラーがでます。 他に方法があれば教えてください。 宜しくお願い致します。 Sub test() Dim 検索値 As Range '検索値 Dim 検索用格納配列 As Variant '検索用格納配列 Dim 出力範囲 As Range '出力範囲 Dim i As Long Dim 検索範囲 As Range Dim endrow As Long Dim ws As Worksheet endrow = Sheets("①SPOT売却明細貼付").Range("B" & Rows.Count).End(xlUp).Row Set 検索値 = Worksheets("②価格集計").Range("B3:B302") Set 出力範囲 = Worksheets("②価格集計").Range("U3:U302") ws = Worksheets("②価格集計").Range("U2").Value 検索範囲 = Worksheets(社名).Range("A:M") 検索用格納配列 = Range(検索値, 出力範囲) For i = 1 To endrow 検索用格納配列(i, 1) = "=VLOOKUP(B" & i + 1 & ",ws!A:M,13,0)" Next 出力範囲 = 検索用格納配列 End Sub
- 締切済み
- Excel（エクセル）
- EXCEL VBAの配列でわかりません。
こんなコードがあるのですが、最後の他のシート（作業中シート）に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ～？？わからな～い？？おしえてくださーい！！ Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBA抽出がうまく出来ません
エクセル2013VBA初心者です。 入力シートからＤＢシートへ、ＤＢシートから印刷シートへのデータ転記と印刷、入力内容のクリアまでは出来るようになりました。 ＤＢシートの検索を行い、記録内容を入力シートに転記する抽出を行いたいのですが、下記構文を書いたところで問題が発生しました。 If Sh2.Range("A & i").Value = j And Sh2.Range("B & i").Value = k Then でとまります。メッセージは ‘Range’メソッドは失敗しました：‘Workshieet’オブジェクトというものです。 やろうとしていることは、入力シートに設けた“E12”と”G12”の二つの検索項目をキーにDBシートの行を特定し、この行の内容を入力シートに反映しようということです。 入力シートの検索項目“E12”、 ”G12”はそれぞれDBシートのA列、B列に格納されている項目で、年度と連番です。サンプルとして入力シート"C5"に抽出しようとしているDBシートD列は申請者名です。 恐れ入りますがよろしくご教示頂きたく、お願い申し上げます。 Sub DBシートから力情報を抽出する () Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim i As Long Dim j As Long Dim k As Long Set Sh1 = Worksheets("入力") Set Sh2 = Worksheets("DB") j = Sh1.Range("E12").Value k = Sh1.Range("G12").Value With Sh2 For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row If Sh2.Range("A & i").Value = j And Sh2.Range("B & i").Value = k Then Sh1.Range("C5").Value = Sh2.Range("D & i").Value End If Next End With End Sub
- ベストアンサー
- Excel（エクセル）
