- ベストアンサー
EXCE2010マクロで文字の比較ができない
- EXCE2010のシートに入っている文字の比較を行っても期待する結果が得られない問題に困っています。
- シートには例題.jpgの通りにデータが入っており、B列で201301だけを抽出したいです。
- マクロを使ってMaxRowとMaxColを設定し、Forループで条件を満たさない行を削除する処理を行っています。
- みんなの回答 （7）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (6)
- cj_mover
- ベストアンサー率76% (292/381)
お邪魔します。 まず、ご提示のコードをそのまま 無難な方法で書き換えてみます。 試した結果をこちらに解る様に具体的にフィードバックしてください。 （ダメでした、という返信はお断りします。） Sub Re8048579() Dim nengetsu As String Dim MaxRow As Long Dim MaxCol As Long Dim i As Long nengetsu = "201301" MaxRow = Range("B65536").End(xlUp).Row MaxCol = Range("IV1").End(xlToLeft).Column For i = MaxRow To 2 Step -1 If Cells(i, "B").Text <> nengetsu Then ' Rows(i).Interior.Color = vbRed Rows(i).Delete Shift:=xlShiftUp End If Next i End Sub 上のコードでも、期待の結果が得られない場合。 VBAというよりEXCELでのセルの扱いに関する理解をもう少し深めて、 色々な条件によって、違いが生じる、それぞれの場合、に適した方法 を、自分で、見つけようと考えなければ、解決は無理です。 B列のデータ型は？ B列の表示形式は？ B列は数式？ B列の実際の値は？ B列の見た目の値は？ 下のコードを実行して、イミディエイトウィンドウに出力されたものを 丸ごと、補足欄に張付けてみましょう。 B列の設定を反映できずに失敗していた場合は、 この実行結果を見れば対処を見つけられます。 Sub CheckCellsProperties() With Range("B2") Debug.? TypeName(.Value), .NumberFormat, .NumberFormatLocal, .HasFormula Debug.? "■v■"; .Value; "■v2■"; .Value2; "■f■"; .Formula; "■t■"; .Text; "■" End With End Sub
お礼
大変申し訳ありませんでした。補足の補足です。Rows(i).Interior.Color = vbRedで色を変えられていると思うのですが、色は変わりませんでした。あまりにもうれしかったので、書き忘れました。大変申し訳ありませんでした。
補足
下のマクロは文字バケしてみえませんでした。上のマクロをコピペしました。結果は、項目行を除いて旨くいきました。項目行除いての意味は、項目行が削除されていました。まだ、手計算はしておりませんが、きっと合っていると思います。上のマクロのNext iの後に、Debug.Print Cells(i, "B").Value Debug.Print nengetsuと入れましたが、201301 201301が出ました。なぜ2回か判りません。また、どちらのDebug.Printが書いたのかも判りません。これから、項目行が何故、削除されたか、何故イミディエイトウインドウに201301 201301と書かれたかを調査したいと思います。本当に有難う御座います。これから自力で頑張ってみます。しかし、またお世話に成るかもしれませんので、旨く検証出来れば、ベストアンサーにさせて頂きたいと思います。結果が出次第補足でお知らせいたします。何卒宜しくお願い申し上げます。
- K Kazz（@JazzCorp）
- ベストアンサー率31% (549/1751)
文字、というんだから文字ナンでしょう、、、 'Option Explicit Sub main() MaxRow = Range("B65536").End(xlUp).Row For i = MaxRow To 2 Step -1 If (Cells(i, "B").Value <> "201301") Then ActiveCell.EntireRow.Delete Shift:=xlShiftUp End If Next i End Sub
補足
やはり結果は、NGでした。皆さん本当に有難う御座います。また、この質問を見ている方々には、大変申し訳ないと思っております。しかし、もう少しお付き合い願います。何卒宜しくお願い申し上げます。
- tom04
- ベストアンサー率49% (2537/5117)
No.2です。 補足に ＞コピペしました。結果はNGでした。 とありますが、原因としては （1）画像を見る限りSheet1だけしか表示されていないので、Sheet2が存在しない。 （2）B列がシリアル値である。 といったコトが考えられます。 Sheet見出しにSheet2が表示されているかどうか確認して今一度試してみてください。 （当然Sheet名が違ってもエラーとなります。） 尚、B列がシリアル値で表示形式だけを yyyymm としている場合は前回のコードでは無理ですので、 B列がシリアル値のコードを載せてみます。 Sub Sample1() Dim wS1 As Worksheet, wS2 As Worksheet Set wS1 = Worksheets("Sheet1") Set wS2 = Worksheets("Sheet2") wS2.Cells.ClearContents With wS1 .Cells(1, 1).AutoFilter Field:=2, Criteria1:=">=2013/1/1", _ Operator:=xlAnd, Criteria2:="<2013/2/1" .Cells(1, 1).CurrentRegion.Copy wS2.Cells(1, 1) .AutoFilterMode = False End With End Sub ※ 今度はどうでしょうか？m（_ _）m
補足
これもコピペしましたが結果は、NGでした。
- pa_cotta
- ベストアンサー率43% (25/58)
debug.print 変数名 これでイミディウェイトウィンドウ(だった気がする…)に変数の内容が出力されるので、期待している値が取得できているかどうかを確認しましょう。
補足
ANo.5さんのマクロでDebug.Printを試してみました。しかし、Cells(i, "B").Valueはイミデイトウインドウには出ませんでした。しかし、比較している"201301"は出てきました。しかし、数が多すぎて値は合っているのですが、やはり、Cells(i, "B").Valueは出ないので、デバッグにはなりませんでした。
- tom04
- ベストアンサー率49% (2537/5117)
こんにちは！ ＞B列で201301だけを抽出したく・・・ とありますのでB列は日付（シリアル値）ではなく、単に201301のように数値だけが入力されているという解釈です。 元データはSheet1にあり、Sheet2に表示するようにしてみました。 標準モジュールに↓のコードをコピー＆ペーストしてマクロを実行してみてください。 尚、Sheet1のデータは画像どおり1行目はタイトル行になっているとします。 Sub Sample1() Dim wS1 As Worksheet, wS2 As Worksheet Set wS1 = Worksheets("Sheet1") Set wS2 = Worksheets("Sheet2") wS2.Cells.ClearContents With wS1 .Cells(1, 1).AutoFilter field:=2, Criteria1:=201301 .Cells(1, 1).CurrentRegion.Copy wS2.Cells(1, 1) .Activate .AutoFilterMode = False End With End Sub こんな感じではどうでしょうか？m（_ _）m
補足
コピペしました。結果はNGでした。
- FEX2053
- ベストアンサー率37% (7987/21355)
nengetsuの変数は、どういう形で入ってますか？ 日付シリアルの比較は往々にして間違いますよ。 あと、IF文の書式がそもそも間違ってるんですが・・・。
補足
全くおしゃられる通りでした。 If MyBln = Cells(i, "B") <> nengetsu Then ActiveCell.EntireRow.Delete Shift:=xlShiftUp End If でした。どうもすみません。
関連するQ&A
- 文字ではなく数字で比較
下のマクロで列を比較しますが，2358と12358が同じ文字になります． 下の文字を数字に変えたいです． Sub 比較して色を付ける() '比較部分 Dim RetRange As Range Range("D2:D35323").Select For i = 1 To 35323 Set RetRange = Selection.Find(What:=Cells(i, 4).Value, _ after:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext) If Not RetRange Is Nothing Then If RetRange.Address <> Cells(i, 4).Address Then RetRange.Interior.ColorIndex = 6 Cells(i, 4).Interior.ColorIndex = 6 End If End If Next END Sub マクロは全然知らない初心者です． よろしくお願いします．
- ベストアンサー
- Visual Basic
- エクセルで型番ごとにワークシートをマクロで作る方法
昨日に質問させて頂いたものですが、下記のマクロを教えて頂いたのですが 新しく生成された型番のワークシートが抜けていたり、最後まで型番が生成されない状態です。 なにか間違っていたら直して頂ける方お願いします。 Sub macro4() Dim h As Range Dim w As Worksheet Dim i As Long, e As Long Application.ScreenUpdating = False Application.CutCopyMode = False ’準備 Set w = ActiveSheet w.Range("4:4").Insert shift:=xlShiftDown e = Range("B65536").End(xlUp).Offset(1).Row Range("B4").Select ’複写 Do ActiveSheet.Copy after:=ActiveSheet Selection.EntireRow.Delete shift:=xlShiftUp Loop Until ActiveCell.Offset(1) = "" ’片付け For i = ActiveSheet.Index To w.Index + 1 Step -1 With Worksheets(i) .Range(.Range("B4").Offset(1), .Cells(e, "B")).EntireRow.Delete shift:=xlShiftUp End With Next i w.Rows(4).Delete Application.ScreenUpdating = True End Sub http://okwave.jp/qa/q7081084.html
- ベストアンサー
- その他MS Office製品
- エクセルでデータの比較をしたいです。お教え頂けないでしょうか
エクセルでデータの比較をしたいです。お教え頂けないでしょうか エクセルで２つのシートにある同一の商品コードと 在庫数を比較するマクロを作成中です。 シート1のA列にある商品コードとB列にある在庫数を取得し シート2のA列にある商品コードから同じ商品コードを探します。 同一の商品コードがあった場合に在庫数を比較して その数が減少していなければC列に次の処理を加える。 商品コードが合致した後は 処理を抜けて次の商品コードを比較させたいのですが 下行にある商品コードを探し続けてしまいます。（データの総当りとなる） つきましては どの様に記述すれば良いのでしょうか お教え頂けます様 よろしくお願い致します。 ＊＊＊＊＊＊＊＊＊＊＊ Sub check1() Dim kz1 As long 'シート1データ数 Dim kz2 As long 'シート2データ数 Dim st1 As String 'シート名 Dim dt1 As Variant '商品コード Dim dt2 As Variant '在庫数 Sheets("sheet1").Select st1 = ActiveSheet.Name kz1 = Range("a65536").End(xlUp).Row Range("a1").Select ActiveCell.Offset(1, 0).Select For a = 0 To kz1 - 2 Sheets(st1).Select dt1 = ActiveCell.Value '商品コード dt2 = ActiveCell.Offset(0, 1).Value '在庫数 Sheets("sheet2").Select kz2 = Range("a65536").End(xlUp).Row Range("a1").Select ActiveCell.Offset(1, 0).Select For b = 0 To kz2 - 1 '同一商品コードを検索 if activecell.value = dt1 '在庫数を比較 if activecell.value >= dt2 '在庫数が同じ もしくは増加していた場合に処理 '次の処理を追加 endif else ActiveCell.Offset(1, 0).Select endif Next b Sheets(st1).Select Next a end sub
- ベストアンサー
- Visual Basic
- マクロ 文字列の比較について質問
いつもお世話になっています。 マクロの文字列の比較方法について質問致します。 異なるシートの文字列を比較して、一致したら処理をするというマクロを作っているのですが、文字列の比較がうまくいきません。 解る方がいましたらアドバイスをお願いします。 Rangeの使い方がおかしいのでしょうか？ For L = 1 to LAST step 1 If Range(Sheet1.Cells(L, 1)).Text = Range(Sheet2.Cells(M, 2)).Text Then ・ ・ ・ end if ※Mは定数です。
- ベストアンサー
- オフィス系ソフト
- VBA 比較してリンク
初めまして。VBA初心者です。 まずはこちらを見て下さい。 Sheet1 Sheet2 A B C D A B C D 1 大区分 中区分 名称 20 大区分 中区分 名称 2 A a あ 1 21 A a あ 1 3 い 2 22 い 2 4 う 3 23 う 3 5 え 4 24 お 5 6 お 5 25 b あ 1→6 7 b あ 6 26 い 2→7 8 い 7 27 う 3→8 9 う 8 28 お 5→10 10 え 9 29 B a か 11 11 お 10 30 き 12 12 B a か 11 31 け 14 13 き 12 32 こ 15 14 く 13 33 b か 11→16 15 け 14 34 き 12→17 16 こ 15 35 け 14→19 17 b か 16 36 こ 15→20 18 き 17 19 く 18 20 け 19 21 こ 20 元々関数を使用していたのですが、数があまりに多くなってきたため、VBAで処理できればと初めて作ってみましたが、途中で行き詰った為ご教授お願いします。 Sheet1,2にそれぞれ表があり、Sheet1が元となります。（行は1000行以上になることもあります。） それで、Sheet2の名称をSheet1の名称と比べ同じ場合、Sheet1のD列をSheet2のD列にリンクさせたいのです。 一応、色々見ながら下記のように組んでみたのですが、矢印の左側のようになってしまいます。 これを、右側のような結果にしたいのですが、なんとなく間違ってる箇所は分かるものの、どのようにしていいか分かりません。 これをどのようにしたらよろしいでしょうか？若しくは、他にやり方があれば教えて頂きたいです。 分かりづらい説明で申し訳ないですが、よろしくお願い致します。 sub test() Dim i As Integer,maxrow As Integer maxrow = Sheet2.Range("C" : Rows.Count).End(xlup).Row For i = 1 To maxrow - 19 If Sheet1.Cells (1+i,3)=Sheet2.Cells(19+i,3) Then Sheet2.Cells(19+i,4)="=Sheet1" & Sheet1.Cells(1 + i,3).Offset(0,1).Address Else Sheet2.Cells(19+i,4)="=Sheet1" & Sheet1.Cells.Find(Sheet2.Cells(19+i,3)) _ .Offset(0,1).Address End if Next i End sub
- ベストアンサー
- その他（プログラミング・開発）
- アプリケーション定義またはオブジェクト定義のエラー
ＶＢＡを勉強し始めて１週間ほどになります。 そこで、掲題のエラーが出てしまい、何が原因か分からず途方にくれてます。 掲題のエラーで検索すると、同じようなエラーで悩んでいる人がいますが、 私の事例を解決する案を見つけることが出来ませんでしたので、 今回質問させていただきます。 まず、下記で示すプロシージャとは別のＳＵＢプロシージャで計算し、表を 作成します。表は、計算条件によって行数が変わります。 その表をクリアさせるのに、下記で示すSUBプロシージャを作成しました。 Public Sub 値のクリア() Dim a_clr As Integer 'Ａ列の縦の値 Dim b_clr As Integer 'Ｂ列の縦の値 Dim MaxRow As String '表の最終行を取得 Dim MaxCol As String '表の最終列を取得 MaxRow = Cells(Rows.Count, 4).End(xlUp).Row '表の行の最終行を取得 MaxCol = Cells(7, Columns.Count).End(xlToLeft).Column '表の列の最終列を取得 MsgBox (MaxRow) MsgBox (MaxCol) Worksheets("計算").Range("d7", Cells(MaxRow, MaxCol)).ClearContents ← エラーになる。 Worksheets("計算").Range("d7", Cells(MaxRow, 16)).ClearContents ←問題なく動作します。 End Sub これを動作させると、掲題のエラーが出ます。 エラーが出る箇所は、Rangeプロパティの行です。 プログラム中にも書いてますが、書き方により動作したり しなかったりします。 Range("d7", Cells(MaxRow, MaxCol)).ClearContents ← エラーになります。 Range("d7", Cells(MaxRow, 16)).ClearContents ← 問題なく動作します。 デバッグモードの時に、Cells(MaxRow, MaxCol))の中の変数（MaxRow, MaxCol）にマウス を持っていくと、数値が表示されます。 その数値は、私が必要としている数値がきちんと入っています。 それなのに、なぜここでとまっているのか分かりません。 また、Cells(MaxRow, MaxCol)をCells(MaxRow, 16)の用に数値にすると 問題なく動作する理由もよく分かりません。 変数の指定の仕方などが悪いのか、今一理解しきれていないのが原因かも 知れませんが、アドバイスをいただけると助かります。 よろしくお願いします。
- ベストアンサー
- Visual Basic
- EXCEL 頭に特定の文字があった場合、文字記入
B列に複数の品番がありますが、頭に「CY」があった品番のみK列に「図面は不要」と自動で入力するように下記マクロに追加したいのですが、教えて下さる方からの回答をお待ちしています。 ※BからK列のJ列に記載があったものだけを抜粋しています。 sub macro() range("B:K").autofilter field:=9, criteria1:="=" activesheet.autofilter.range.offset(1).entirerow.delete shift:=xlshiftup activesheet.autofiltermode = false end sub
- ベストアンサー
- Excel（エクセル）
- Excel VBA; 複数のループ処理
↓のようなコードがあります。 Dim i As Long, MaxRow1 As Long, MaxRow2 As Long MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To MaxRow1 Worksheets("Sheet1").Cells(i, 1).Value = i . Next i For i = 1 To MaxRow2 Worksheets("Sheet2").Cells(i, 1).Value = i . Next i これらを最大行の多いシートに合わせて、パフォーマンスを良くしたいと思います。 同様の処理をシート1、シート2で実施しているので纏めて記述したいです。 シート1、シート2に対する処理をサブルーチンにする方法しかありませんか? どなたかお願いします。 If MaxRow1 >= MaxRow2 Then For i = 1 To MaxRow1 Else For i = 1 To MaxRow2 End If Worksheets("Sheet1").Cells(i, 1).Value = i Worksheets("Sheet2").Cells(i, 1).Value = i . Next i
- ベストアンサー
- Visual Basic
- Excel2013VBA列選択の拡大
ExcelVBA2013です。 列の取得でつまづいております。 お手数ですが、ご教授下さい。 下記のコードで選択範囲のコピー貼り付けは出来ていますが、列幅がコピーされていませんでした。 CC3のセルを基準にOffsetとResizeで範囲拡大してコピーしているためだと思います。 CC3の左隣のAX3:CB3はセル結合されています（○月）。（その下の4行目は日付の１～31が入力） 列は、今回はAX3:CC3まで（1月分）取得できればよいです。（可変します） MaxCol = Range("J5").End(xlToRight).Column で列取得できます。 行の位置は、MaxRow = Range("I5").End(xlDown).Row で取得した値です。 それで、列全体を取得しようと、 MaxCol = Columns(MaxCol).Select で最終列は取得できましたが、そこから列選択の拡大ができればと思っています。 現在は、AX3:CC237まで取得コピーして、隣の列に貼り付けで列幅が違う。 希望はAX:CCまでの列を取得選択コピーして貼り付け。 Sub SAMPLE() Dim MaxRow As Variant, MaxCol As Variant Dim r As Range, c As Range MaxRow = Range("I5").End(xlDown).Row '最終行番号 MaxCol = Range("J5").End(xlToRight).Column '最終列番号 Set c = Cells(3, Cells(3, Columns.Count).End(xlToLeft).Column) '表の右上角のセル番地を取得 c.Select c.Offset(0, -31).Resize(MaxRow - 2, 32).Copy c.Offset(0, 1) '表右上から１月分選択範囲拡大してコピー隣の列より貼りつけ End Sub
- ベストアンサー
- Excel（エクセル）
- VBAで空白行を削除する。
初めまして、VBA初心やです。なので具体的にご教授願います。環境WindoesXP SP3 EXCEL2010です。やりたい事Book1に空白行が沢山あるSheetが一枚あります。Sheetの中身は下記の通りです。 一行目に項目があります。n行目にも項目があります。nは、10個です。項目の下の行には、デターがあります。以下のようになっております。初めの位置はB2です。 B2 項目Ａ 項目B 項目C 項目D・・・・・ 項番１ データ1 データ2 データ3 データ4・・・・・・ 項番2 データ1 データ2 データ3 データ4・・・・・・ 項番3 データ1 空白 データ3 データ4・・・・・・ 項番4 データ1 データ2 空白 データ4・・・・・・ 項番5 データ1 データ2 空白 空白・・・・・・ 項番6 データ1 データ2 空白 空白・・・・・・ 項番7 データ1 データ2 空白 空白・・・・・・ 項番8 空白 空白 空白 空白・・・・・・ ・ ・ ・ ・ ・ Bn 項目Ａ 項目B 項目C 項目D・・・・・ 項番１ データ1 データ2 データ3 データ4・・・・・・ と続きます。この項番1は残して、項番8の様な空白セルが続く行だけ削除したいので、 以下のマクロを組みました。 Dim ii As Long Dim MaxRow(1 To 100) As Long Dim MaxCol As Long '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ MaxRow(1) = Cells(Rows.Count, 2).End(xlUp).Row MaxRow(2) = Cells(Rows.Count, 21).End(xlUp).Row MaxRow(3) = Cells(Rows.Count, 22).End(xlUp).Row MaxRow(4) = Cells(Rows.Count, 23).End(xlUp).Row MaxCol = Range("IV4").End(xlToLeft).Column Application.ScreenUpdating = False '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ For i = MaxRow(1) To 3 Step -1 '配列にした。 '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ For j = 1 To MaxCol Step 1 '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ If Cells(4, j).Value = "" Then GoTo Label22 'Else GoTo Label11 Label22: Range(4 & ":" & MaxCol).Delete Label11: Next j 'End If Next i Application.ScreenUpdating = True MsgBox "マクロが終了しました" End Sub しかし、ソートしてMaxRowの配列のいくつになるかを計算する処が判りません。 なので、空白行を削除できません。 ようするに、各項目(行)の空白セルがまちまちで(凹凸があり)、全ての項目が空白である処を探す事が出来ません。 何卒宜しくご教授願います。
- ベストアンサー
- オフィス系ソフト
お礼
本当に有難う御座います。やっとマクロのプログラムが動作して、正解な回答が出る様になりました。きめ細かい、親切でご丁寧な解説どうも有難う御座います。この質問を見ていた方々や、回答を寄せられた方々にも、本当に有難う御座います。1回実行して、検証するまで時間が掛かりどうもすみませんでした。今後とも何卒宜しくお願い申し上げます。