Excel 2007 VBAでの比較演算子<>の不具合の対処方法を教えてください
- Excel 2007 VBAを使用している際に、<>（不等号）を使用したif文で不具合が発生しています。商品シートのC列には、「受取済み」「注文中」以外の行データが存在するのに、検出されない問題が発生しています。
- 対処方法を教えてください。
- セルの書式は標準になっています。
- ベストアンサー
比較演算子 <> について
Excel 2007 VBAを使用しています。 ↓のコードを実行するとif文のところで不具合があります。 商品シートのC列には、状況が保存されています。 "受取済み"、"注文中"以外の行データをリストさせます。 商品シートのC列には、"受取済み"、"注文中"以外の行データが存在するのですが、まったく検出してくれません。 セルの書式は標準になっています。 対処方法を教えてくれませんか? Dim i As Long Dim inSheet As Worksheet Set inSheet = Worksheets("商品") For i = 1 To 10 If CStr(inSheet.Cells(i, "C").Value) <> "受取済み" And _ CStr(inSheet.Cells(i, "C").Value) <> "注文中" then . . End if Next i
- genesis50
- お礼率11% (10/86)
- その他（プログラミング・開発）
- 回答数1
- ありがとう数10
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
書かれている範囲では、おかしいところは無いです。 ここに書かれていない部分がおかしいと思われます。 For i = 1 To 10 If CStr(inSheet.Cells(i, "C").Value) <> "受取済み" And _ CStr(inSheet.Cells(i, "C").Value) <> "注文中" then inSheet.Cells(i, "A")=1 Else inSheet.Cells(i, "A")=0 End if Next i にしてみましたが、ちゃんとA列に1と0が入りました。
関連するQ&A
- テキストボックスの日付と文字列の処理
Excel 2007 VBAを使用しています。 下記のようなことを考えています。 1. テキストボックスにyyyy/m形式の日付データを入力 2. ボタンシートのコマンドボタンを押下。 3. テキストボックスの日付データを確認 4. 商品シートの列値、日付データ(A列)、商品番号(B列)、商品名(C列)、状況(D列)から条件に 該当した行を結果シートに行コピー。 ただし、日付データ(A列)には日付データ以外にも文字列データ、"未定"、空白セル("")などがございます。 そして、商品シートの3行目のベッダー情報は先頭に置いて、その下に該当行を行コピーしていく。 質問; 解らないのは、同じif文で日付データと文字列データとの処理です。 テキストボックスのyyyy/m形式の日付データを基にその日付以降の該当する行を別のシートに コピーしていくのですが、参照元の商品シートの日付データ(A列)には他に文字列データが存在します。 この文字列データも抽出の対象にしたいのです。 あと、テキストボックスのyyyy/m形式の日付データは半角入力しますが全角入力されたとき エラー表示させる方法はありますか? これらの処理を行うにあたりサンプルなるコードはありませんか? 商品シートの3行目のベッダー情報は先頭に置いて、その下に該当した行を行コピーしていく。 1. 商品シート; 注文日付 商品番号 商品名 状況 2010/9 312000 ノコギリ 受取済み 2014/5 542000 ハンマー n/a 未定 544000 トンカチ n/a (空白セル) 542000 ハンマー n/a 2014/11 312000 ノコギリ 注文中 ・ ・ 2. ボタンシートで、日付データを入力(2014/5)、実行ボタンを押下。 条件は2014/5以降で、状況が"受取済み"、"注文中"以外の行データをコピーして状況が未確定のリストを作成します。 そして、注文日付が"未定"、空白セル("")の行データもコピーします。 そして、順次、結果シートに行コピーしてします。 結果シート; 注文日付 商品番号 商品名 状況 2014/5 542000 ハンマー n/a 未定 544000 トンカチ n/a (空白セル) 542000 ハンマー n/a ・ ・ VBAコード; Option Explicit Private Sub CB2_Click() '変数を定義 Dim i As Long Dim maxRow As Long Dim cnt As Long Dim inSheet As Worksheet Dim outSheet As Worksheet '入出力先のシートをオブジェクト変数へ格納 Set inSheet = Worksheets("商品シート") Set outSheet = Worksheets("結果シート") 'テキストボックスの内容を判定 '全角入力されたときエラー表示させる方法はありますか? If (Me.TextBox1.Value = "") Or (Not IsDate(Me.TextBox1.Value)) Then MsgBox "日付が正しく入力されていません" Exit Sub End If maxRow = inSheet.Cells(Rows.Count, "A").End(xlUp).Row '商品シートの最終行番号で分岐処理 If maxRow > 3 Then '出力先を削除してヘッダーをコピー outSheet.Cells.Delete inSheet.Range("A3").EntireRow.Copy outSheet.Range("A1") Application.CutCopyMode = False Else '4行目以降にデータが入力されていなければメッセージで終了 MsgBox "該当データがありません" Exit Sub End If '4行目から最終行まで繰り返し For i = 4 To maxRow 'ここからが上手くいきません。 'If IsDate(inSheet.Cells(i, "A").Value) Then 'フィルター条件; 'A列 注文日付 → 2014年05月以降、未定、(空白セル) 'D列 金額 → 受取済み、注文中以外 If inSheet.Cells(i, "A").Value >= CDate(Me.TextBox1.Value) And _ CStr(inSheet.Cells(i, "A").Value) = "未定" And _ CStr(inSheet.Cells(i, "A").Value) = "" And _ CStr(inSheet.Cells(i, "D").Value) <> "受取済み" And _ CStr(inSheet.Cells(i, "D").Value) <> "注文中" Then inSheet.Rows(i).Copy outSheet.Rows(cnt + 2) cnt = cnt + 1 End If 'End If Next i End Sub
- ベストアンサー
- Visual Basic
- if文について
Excel 2007 VBAを使用しています。 ↓のクリックイベントを実行するとif文のところで不具合があります。 商品シートのC列には、状況が保存されています。 該当した年月、"受取済み"、"注文中"以外の行データをリストさせます。 商品シートのJ列、W列には、該当した年月、"受取済み"、"注文中"以外の行データが存在するのですが、まったく検出してくれません。 対処方法を教えてくれませんか? ------------------------------------------- Option Explicit Private Sub CB1_Click() '変数を定義 Dim i As Long Dim maxRow As Long Dim inSheet As Worksheet Dim outSheet As Worksheet '入出力先のシートをオブジェクト変数へ格納 Set inSheet = Worksheets("商品") Set outSheet = Worksheets("結果") 'テキストボックスの内容を判定 If (Me.TextBox21.Value = "") Or (Not IsDate(Me.TextBox21.Value)) Then MsgBox "日付が入力されていません" Exit Sub End If '最終行番号を取得 maxRow = Me.Cells(Rows.Count, "A").End(xlUp).Row '商品シートの最終行番号で分岐処理 If maxRow > 3 Then '出力先を削除してヘッダーをコピー outSheet.Cells.Delete inSheet.Range("A3").EntireRow.Copy outSheet.Range("A1") Application.CutCopyMode = False Else '4行目以降にデータが入力されていなければメッセージで終了 MsgBox "該当データがありません" Exit Sub End If '4行目から最終行まで繰り返し For i = 4 To maxRow 'J列が日付であれば処理 If IsDate(inSheet.Cells(i, "J").Value) Then '--------機能しない箇所(開始) If Year(inSheet.Cells(i, "J").Value) <= Year(Me.TextBox21.Value) And _ Month(inSheet.Cells(i, "J").Value) <= Month(Me.TextBox21.Value) And _ CStr(inSheet.Cells(i, "W").Value) <> "受取済み" And CStr(inSheet.Cells(i, "W").Value) <> "注文中" Then '--------機能しない箇所(終了) inSheet.Rows(i).Copy outSheet.Rows(cnt + 2) End If End If Next i End Sub
- ベストアンサー
- その他（プログラミング・開発）
- Excel VBAで文字列の部分一致の文字列を表示
以前、こちらで頭５文字までの一致で文字列を表示するVBAを教えて頂きました。今回はFINDなどの部分一致での文字列を表示することをしたいのですが、ご教示いただけますと幸いです。 下記はSheet1のA3に文字を5文字以内いれるとSheet２のC列からピックアップしてSheet１のA列に文字列を表示する及びSheet２のB列のデータをSheet１のC列に表示させるVBAです。 Sub Test2() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim SData As String, i As Long, VRet As Variant Dim c As Range, LastRow As Long Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") SData = CStr(Ws1.Range("A3").Value) If SData = "" Then Exit Sub i = 5 LastRow = Ws1.Cells(Rows.Count, "A").End(xlUp).Row If LastRow < i Then LastRow = i End If Ws1.Range(Ws1.Cells(i, "A"), Ws1.Cells(LastRow, "C")).ClearContents With Ws2 For Each c In .Range(.Cells(1, "C"), .Cells(Rows.Count, "C").End(xlUp)) VRet = InStr(1, CStr(c.Value), SData, vbTextCompare) If VRet = 1 And Len(c.Value) >= 10 Then Ws1.Cells(i, "A").Resize(1, 2).Value = c.Resize(1, 2).Value 'とりあえずSheet2のB列のデータ(C列のデータに同期したデータ)をSheet1のC列に Ws1.Cells(i, "C").Value = .Cells(c.Row, "B").Value i = i + 1 End If Next End With End Sub 宜しくお願い致します。
- ベストアンサー
- Excel（エクセル）
- セルの内容の比較について
こんにちは。 業務用の簡単なチェックプログラムを作っています。 基本データに扱い商品、日々売上に実際に売れた商品、結果にそれらを照合したデータを書き込むとします。 Private Sub button_Click() Dim i As Integer Dim n As Integer Dim x As Integer Range("A1:B1000").ClearContents n = 1 x = 1 For i = 1 To 1000 If Worksheets("日々売上").Cells(i, 1) = "" Then Exit For End If If Worksheets("基本データ").Cells(x, 1) = Worksheets("日々売上").Cells(n, 2) Then Worksheets("結果").Cells(x, 1).Value = Worksheets("日々売上").Cells(n, 2) Worksheets("結果").Cells(x, 2).Value = Worksheets("日々売上").Cells(n, 7) n = n + 1 x = x + 1 Else n = n + 1 End If Next i End Sub 基本データのシートには、あらかじめ抽出したい商品コードと商品名が書かれていて、日々売上のシートの内容と比較しながら、合致した場合はその商品を結果のシートに書き出すと言う感じです。 エラーは出ないのですが、なぜか途中で基本データの行番号数値の変数ｘが止まってしまい、最後まで照合出来ません。 初歩的なプログラムですが、どうぞよろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- 複数シートから条件に合ったデータを抽出して、別シー
複数シートから条件に合ったデータを抽出して、 別シートにそれぞれコピーしたいのです。 自分なりに本やネットを見て、切貼りで作成したのですが、 全く動作しないのです。マクロ超初心者です。 どなたか新しいVBAもしくは、変更VBAを教えて頂けるとうれしいです。 やりたいことは 一つのBOOK内の複数シート(別表1,2,原本,データのシート以外)から 条件に合うデータを AA列にあるデータ(△,▼)をそれぞれ抽出して、別々のシート(Upgrade、Downgrade)に見出し行より下から 順番(見出行が12行まで)にコピー貼付けした後(書式などがあるので、すべて貼付け) 数式が入ってるので、最後に全体をコピーして値の貼付けをしたいです。 複数シートは基本的に同じですが、稀に列がずれて貼付くことがあるので、 列見出しと同じ場所に貼付けるように設定したいです。 エクセル2003です。 何卒、宜しくお願いいたしますm(__)m 一応、全く使えませんがVBAを貼り付けておきます。 Sub データ更新() Dim U As Worksheet Dim D As Worksheet Dim 行 As Integer Dim 列 As Integer Dim S As Integer Dim A As String Dim B As String Dim C As Range 'コピー先シート名 U.Name = Upgrade D.Name = Downgrade 行 = 13 '開始行 列 = AA '検索列 S = cell(13, 1) '開始セル '検索文字 A = "△" B = "▼" '古いデータ削除 Do Until Sheets(U).Cells(行, A) = "" Cells ClearContents 行 = 行 + 1 Sheets(U).Activate 行 = 13 'シートループ処理 For Each U In Worksheets '除くシート If U.Name <> "別表1" And U.Name <> "別表2" And U.Name <> "データ" And U.Name <> "原本" Then '抽出コピー For 行 = 13 To Range("bD200").End(xlToLeft).Column If Range("AA").Value = A Then If S Is Nothing Then Exit Sub Do Until cell(行, 1) = "" Range(S).CurrentRegion.AdvancedFilter xlFilterCopy, Range("200:56"), Sheets(Cells(S).Text).Range("a13") 行 = 行 + 1 '列名から貼付ける列番号を返す For Each C In convinedseet.Rows(1).Cells If CStr(C.Value) = FieldName Then ColumnNumber = C.Column Exit For elself CStr(C.Value) = "" C.Value = FieldName ColumnNumber = C.Column Exit For Loop End If End If End If Next End Sub
- 締切済み
- オフィス系ソフト
- マクロ for～next うまくいかない
シート内の値を並び替えて、別シートに貼り付けるコード作成中。 ①偶数行の値を奇数行の特定の列に貼り付け、元の値は消す ②(2)と書かれたセルがある場合、その行をコピーして同一行に挿入し、(2)の値は消す この2つが機能しません。 ほか部分は動きます。 これが機能しない原因、分かるでしょうか。 以下、コード Private Sub CommandButton6_Click() Dim i As Long For i = 1 To 9 If Me.Controls("TextBox" & CStr(i)).Value = "" Then 'ユーザーフォーム内のテキスト1～9で空欄があると以下の操作 MsgBox Me.Controls("Label" & CStr(i)).Caption & " が未記入です" '空欄があると、ラベル名＋が未記入ですのメッセージ後、処理終了 Exit Sub End If Next Dim Convert_book As String, GC_book As String, GC_address As String Convert_book = TextBox8.Value '変換シートのブック名を取得 GC_book = TextBox7.Value 'ブックAの名前を取得 GC_address = TextBox6.Value 'ブックAの保存先を取得 With Workbooks(GC_book).Worksheets(ws_name) 'ブックAシート1をWithとする。 .Range("A1:CZ200").UnMerge 'ブックAシート1の結合を解く '部品番号と客先コードをコピー .Range(Cells(Range(Parts_no).Row, Range(Parts_no).Column), _ Cells(Range(Parts_no).Row + 1, Range(Parts_no).Column)).Copy '変換シートに貼付けWorkbooks(Convert_book).Worksheets(1).Range("G4").PasteSpecial Paste:=xlPasteValues '管理№をコピー、変換シートに貼付け .Range(Control_no).Copy Workbooks(Convert_book).Worksheets(1).Range("AJ2").PasteSpecial Paste:=xlPasteValues Dim r As Long, r1 As Long, c As Long, c1 As Long, c2 As Long, c3 As Long '管理№の行と列を取得 r = .Range(Control_no).Row c = .Range(Control_no).Column '材料関連の情報のコピーと貼付け .Range(.Cells(r + 2, c - 4), .Cells(r + 3, Last_column - 1)).Copy Workbooks(Convert_book).Worksheets(1).Range("AF4").PasteSpecial Paste:=xlPasteValues '変数に、加工工程№の行と列を入れる。変更年月日の行、測定具の列、管理№の列も入れる。 r = .Range(Process_no).Row '可変 r1 = .Range(Rev_no).Row '可変 c = .Range(Process_no).Column '32または33列目 c1 = .Range(Tool_name).Column '27または28列目 c2 = Last_column '44または43列目 c3 = .Range(Control_no).Column '通常1列目 .Range(Cells(r, c2), Cells(r1 - 2, c2)).Clear '最終列をすべてクリア Dim k As Long, j As Long k = 1 '最終列に1、2、1、……繰返し数を入れる For i = r To r1 - 2 If k = 1 Then .Cells(i, c2).Value = 1 k = k + 1 Else .Cells(i, c2).Value = 2 k = k - 1 End If Next Dim i1 As Long, k1 As Long, j1 As Long k1 = 1 '管理値の欄で偶数列の値を奇数列に移す For i1 = r To r1 - 2 If .Cells(i1, c2).Value = 2 Then For j1 = c3 + 18 To c1 - 1 If .Cells(i1, j1).Value <> "" Then .Cells(i1 - 1, c3 + 25) = .Cells(i1, j1).Value .Cells(i1, j1).Value = "" End If Next j1 End If Next i1 Dim i2 As Long, k2 As Long, j2 As Long k2 = 1 '"(2)"と書いてある行を2行に増やして、"(2)"を消す For i2 = r To r1 - 2 If .Cells(i2, c2).Value = 1 Then For j2 = c3 + 18 To c1 - 1 If .Cells(i2, j2).Value Like "*(2)*" Then .Cells(i2, j2).Formula = Replace(Cells(i2, j2).Formula, "(2)", "") .Range(Cells(i2, 1), Cells(i2, c2)).Copy .Range(Cells(i2, 1), Cells(i2, c2)).Insert xlShiftToRight End If Next j2 End If Next i2 '最終列の番号順に並べる .Range(Cells(r, 1), Cells(r1 - 2, c2)).Sort _ key1:=Cells(r, c2), order1:=xlAscending End With ～～(この間はまだ未作成)～～ Application.DisplayAlerts = False Workbooks(GC_book).Close SaveChanges:=False Application.DisplayAlerts = True End Sub
- ベストアンサー
- Excel（エクセル）
- プログラムの作り方
まったくの素人です。 1列にあるデータをキーにして情報の抽出をしたいのですが うまくコードが書けません。 何卒、助勢頂ければ幸いです。 よろしくお願いいたします。 具体的な内容) B列 C列 x 11 ・・適当な不要なデータが数行 y (2A) ・・適当な不要なデータが数行 x 12 ・・適当な不要なデータが数行 y (44) ・・適当な不要なデータが数行 x 39 ・・適当な不要なデータが数行 y (7) ・・適当な不要なデータが数行 から、xのデータとyのデータの表を作りたい。 ただし、yのデータ()内はB列のyの次の行。 できれば、抽出したデータはシート2に並べたい。 Sub macro() Dim a As String Dim b As Variant Dim c As range Dim i As Integer a = x b = "y" i = 1 Worksheets("sheet1").range("B1").Activate For i = 1 To 5000 With ActiveCell If .Value = a Then ActiveCell.Offset(0, 1).Copy Worksheets("sheet2").Select Cells(i, 1).Select ActiveSheet.Paste Sheets("sheet1").Select Else ActiveCell.Offset(1, 0).Activate End If If .Value = b Then ActiveCell.Offset(1, 0).Copy Worksheets("sheet2").Select Cells(i, 2).Select ActiveSheet.Paste Sheets("sheet1").Select Else ActiveCell.Offset(1, 0).Activate End If End With Next End Sub
- ベストアンサー
- Visual Basic
- 【Excel VBA】データ貼り付けの開始位置について
Excel2003を使用しています。 先日、こちらでアドバイスをいただきながら、下記のようなマクロを作りました。内容はあるセルの値と同じ名前のシートへデータをコピーするというものです。 Sheet1に貼り付け元のデータが表形式であり、必要なデータのみ該当のシートへコピーします。マクロ実行後は、別の新しいデータをSheet1へコピペして、またマクロを実行するのですが、その際、データの貼り付け開始位置を前回マクロを実行して貼り付けられたデータから2行空けたいのですが、可能でしょうか？ ________________________________________________________________________________________________________________________________ Sub test3() Dim n As Long Dim i As Long Dim j As Long Worksheets("Sheet1").Activate For n = 4 To Cells(Rows.Count, 2).End(xlUp).Row If Cells(n, 3).Value <> "" Then With Worksheets(CStr(Cells(n, 3).Value)) i = .Cells(Rows.Count, 3).End(xlUp).Row + 1 Cells(n, 2).Copy .Cells(i, 2) Cells(n, 7).Resize(, 2).Copy .Cells(i, 4) Cells(n, 11).Copy .Cells(i, 3) End With End If If Cells(n, 13).Value <> "" Then With Worksheets(CStr(Cells(n, 13).Value)) j = .Cells(Rows.Count, 3).End(xlUp).Row + 1 Cells(n, 12).Copy .Cells(j, 2) Cells(n, 17).Copy .Cells(j, 4) Cells(n, 18).Copy .Cells(j, 6) Cells(n, 11).Copy .Cells(j, 3) End With End If Next n End Sub
- ベストアンサー
- オフィス系ソフト
- 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
- ベストアンサー
- オフィス系ソフト
- エクセル マクロ 抽出
教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると 行数＝値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub
- ベストアンサー
- オフィス系ソフト
