- 締切済み
エクセルVBAについての質問です。
エクセルVBAについての質問です。 A列のCという商品名が入った列を削除したい場合下記のようにすれば可能かと思いますが、C列のCという商品名が入った列を削除したい場合どのようにすればよいか教えて下さい。 VBAに関してまだ初心者ですがどうぞよろしくお願いします。 行 = 1 Do 行 = 行 + 1 If Cells(行, 1) = "" Then Exit Do End If '行の値がC以外の時は次の行に移る Do If Cells(行, 1) = "C" Then Rows(行 & ":" & 行).Select Selection.Delete Shift:=xlUp Else Exit Do 'ジャンプ先は内側のDo～Loopのすぐ下 End If Loop 'ジャンプ先はここ If Cells(行, 1) = "" Then Exit Do End If Loop End Sub
- MI-TAN13
- お礼率33% (3/9)
- 財務・会計・経理
- 回答数2
- ありがとう数1
- みんなの回答 （2）
- 専門家の回答
みんなの回答
- n2201makita
- ベストアンサー率30% (8/26)
まずは駄目出しから。 >A列のCという商品名が入った列を削除したい場合 A列のCという商品名が入った行を削除したい場合 >C列のCという商品名が入った列を削除したい場合 C列のCという商品名が入った行を削除したい場合 Cells(行, 1)を、Cells(行, 3)に全て変更すればいいと思いますが、 （特に9行目） ANo.1 さんの指摘を直すため、Selection.Delete Shift:=xlUp の 前後どちらかに 行 = 行 - 1 を入れたほうがいいと思います。
- bin-chan
- ベストアンサー率33% (1403/4213)
> Selection.Delete Shift:=xlUp 削除して、下のセルを上に詰めてます？ 行の値が、Cが２回続くとどうなる？見逃しが生じませんか？ 最下行から上（1行目）に向かって判断したほうが良いような。
関連するQ&A
- エクセルVBAの繰り返し処理の質問
Ｃ列にある項目とＧ列にある項目を比較して、 一致し、Ｈ列にある数字が10以上ならば、Ｂ列にフラグ１を立てる という処理を行いたいんですが、 下記ぐらいまでしか作れず、うまくいきません・・・ Sub フラグを立てる処理() Dim i As Integer Dim j As Integer Dim k As Integer i = 1 j = 1 Do j = j + 1 Do i = i + 1 If Cells(j, 8) > 9 Then Cells(i - 1, 4) = 1 End If Loop Until Cells(i, 3) <> Cells(j, 7) Or Cells(i, 3) = "" Loop Until Cells(j, 7) = "" End Sub わかる方がいらっしゃいましたら、お願いします。
- 締切済み
- Visual Basic
- エクセルVBAについて質問です。
現在、マクロで重複データを削除する処理しています。 一応動作はするのですが、すごく遅いです。 およそ私のPC（XPのQuadコア）で1行処理するのに約0.85秒かかっています。 データが1万行以上もあるようなときは、何時間もかかってしまいます。 エクセルのデータは、以下のように、 A列とB列に文字列が何行にも渡って入っているものです。 A列 B列 AAA BBB CCC DDD EEE FFF GGG BBB CCC HHH CCC DDD （以下同様） 上のようなシートで、A列とB列の両方について重複する行を削除したいと思っています。 上記例だと、一番最後の「CCC-DDD」の箇所を削除したいです。 そこで以下のようなマクロを組みました。 (1)はじめに重複をチェックする変数（A列・B列）を取得します。 (2)上から順にチェックを開始します。 (3)A列・B列双方が取得した変数と一緒なら重複カウンターに1を加える。 （1回目の出現では削除しない） (4)チェックを続け、重複カウンターが2以上になった行は削除する。 (5)上記を空白行まで繰り返す。 というような流れです。 （マクロ記述の途中部分からです） '重複する行を削除 counter3 = 1 Do search_word1 = Cells(counter3, 1).Value search_word2 = Cells(counter3, 2).Value counter4 = 1 double_counter = 0 Do If Cells(counter4, 1).Value = search_word1 And Cells(counter4, 2).Value = search_word2 Then double_counter = double_counter + 1 If double_counter > 1 Then '二度以上出現した場合から削除する Cells(counter4, 1).EntireRow.Delete counter4 = counter4 - 1 End If End If counter4 = counter4 + 1 Loop Until Cells(counter4, 1).Value = "" counter3 = counter3 + 1 Loop Until Cells(counter3, 1) = "" 初心者なのもので、冗長や不適切な箇所などあるかと思います。 より効率的、あるいは、より早くできる書き方がありましたら、 ぜひともお教え下さい・よろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセルVBAで、文字列の検索方法について
先日、こちらで教えていただいたVBAがあります。 E列のセルの文字列の末尾が「計」のものを検索し、その行に色をつけるものです。 Sub iroiro() Dim x, y x = 1 Do If Right(Cells(x, 5), 1) = "計" Then For i = 2 To 5 Cells(x, i).Interior.ColorIndex = 3 Next End If x = x + 1 Loop Until Right(Cells(x, 5), 1) = "" End Sub これはばっちりで、助かっているのですが、今度は末尾ではなく、文字列中に「営業」という文字があるのを検索し、色をつけたいのです。 If Right(Cells(x, 5), 1) = "計" Thenを どう変えればいいのでしょうか？
- ベストアンサー
- オフィス系ソフト
- VBAエクセル空白セル0の入力
C列が空白となるまで、F列・・・L列の空白セルに0を代入する。 という処理を行いたく以下コードで実行をして ファイル種類をCSVにて、保存した後名前の変更で拡張子をTXTにすると データ入力された列の以降がカンマの羅列が「,,,,,,,,(改行)」の繰り返しで表示されてしまいます。 (CSV保存の後、視覚的に空白部分を行選択して削除するとなくなります。) どうすれば、このカンマが表示されなくなるでしょうか。 うまく説明できてないですが、アドバイス御願いします。 Dim i As Long i = 3 Do Until Cells(i, 3).Value = "" If Cells(i, 6).Value = "" Then Cells(i, 6).Value = "0" End If If Cells(i, 7).Value = "" Then Cells(i, 7).Value = "0" End If If Cells(i, 8).Value = "" Then Cells(i, 8).Value = "0" End If If Cells(i, 9).Value = "" Then Cells(i, 9).Value = "0" End If If Cells(i, 10).Value = "" Then Cells(i, 10).Value = "0" End If If Cells(i, 11).Value = "" Then Cells(i, 11).Value = "0" End If If Cells(i, 12).Value = "" Then Cells(i, 12).Value = "0" End If i = i + 1 Loop
- 締切済み
- Visual Basic
- Excel2013>VBA>sendkeys動ず
Excel2013のVBAを使って自動更新をしようと思っています。 A B C １ あ AA 0 ２ い AB 1 ３ う AC 0 ４ え AA 1 ５ お AA 0 上記のようにシート内にデータはあります。B列「AA」C列の「ゼロ」を更新してC列の値を「1」にしようとしたときに、ピボットテーブルを使ってみようと思いました。 ピボットテーブルにてB列の「AA」、C列の「ゼロ」を抽出表示しました。 A B C １ あ AA 0 ５ お AA 0 思っていたように1行目と5行目が抽出されました。 後はゼロを別の値（仮に「2」とします）に変更するときに、カーソルの移動がうまくいきませんでした。 Range("C1").End(xlDown).Select Do ActiveCell.Offset(0, 0) = "2" ActiveCell.Offset(-1, 0).Select If Len(ActiveCell.Offset(0, 0)) = 0 Then Exit Do End If Loop しかし、これではカーソルが「C4」に移動してしまいました。 ピボットテーブルでたたんでしまっても、カーソルは見えないセルに移動するようです。 そこで、下記のように変更しました。 Range("C1").End(xlDown).Select Do ActiveCell.Offset(0, 0) = "2" Application.SendKeys "{UP}" If Len(ActiveCell.Offset(0, 0)) = 0 Then Exit Do End If Loop これは、カーソルがまったく動かずに最初の地点にいたままでした。 そこで、次はTABで移動することにしました。 Range("C1").Select Selection.SpecialCells(xlCellTypeVisible).Select Do ActiveCell.Offset(0, 0) = "2" Application.SendKeys "{tab}" If Len(ActiveCell.Offset(0, 0)) = 0 Then Exit Do End If Loop これでもカーソルは動きませんでした。 どうにかしてsendkeysの動かし方、もしくは更新でもっとうまいやり方をご存知の方、是非教えてください。よろしくお願いいたします。
- ベストアンサー
- その他（プログラミング・開発）
- VBAで教えてください。
データがないときはExitSubしたいのですが、何処に記述すれば良いでしょうか？ Sub 削除() Dim i As Long If MsgBox("データを削除します。よろしいですか？", vbYesNo) = vbYes Then Sheets("リスト").Select i = 5 Do Until i = 200 If Cells(i, 5).Value = Sheets("マスタ登録").Range("D5") Then Cells(i, 1).EntireRow.Delete End If i = i + 1 Loop Else Exit Sub End If End Sub
- ベストアンサー
- オフィス系ソフト
- このVBAソースのどこが間違ってるか教えてください
Dim csp As Integer 'ストップ Dim css As Integer 'ストップorスタート Sub Quest2() If css = 0 Then css = 1 Quest2a Else cstp = 1 css = 0 End If End Sub Sub Quest2a() Sheets("Sheet1").Select Range("B1:J10").Select Selection.Interior.ColorIndex = x1None Range("a1").Select cstp = 0 Do r = 1: c = 5 For i = 0 To 15 If i < 9 Then Cells(r, c).Interior.ColorIndex = x1None r = r + 1 If i < 5 Then c = c + 1 Else c = c - 1 End If Cells(r, c).Interior.ColorIndex = 3 Else Cells(r, c).Interior.ColorIndex = x1None r = r - 1 If i < 13 Then c = c - 1 Else c = c + 1 End If Cells().Interior.ColorIndex = 3 End If 'タイミング For tm1 = 1 To 1000: For tm2 = 1 To 100: Next If cstp = 1 Then Exit For End If Next DoEvents If cstp = 1 Then Exit For End If If r = 3 And c = 5 Then Cells(r, c).Interior.ColorIndex = x1None End If Next DoEvents If cstp = 1 Then Exit Do End If Loop Cells(10, 9) = Cells(r, c) Cells(10, 9).Interior.ColorIndex = 8 End Sub
- ベストアンサー
- その他（プログラミング・開発）
- エクセルVBAで検索してシートへ貼り付け。
どうも。 エクセルでVBAをやっています。 表に映画のデータベースのように打ち込んで VBAフォームでタイトルを検索して、ヒットした行を別シートに出力するというのがやりたいのですが、できないのです。 Private Sub CommandButton1_Click() '変数の宣言 strTitle = "" intEndIndex = 0 intTate = 1 intYoko = 1 With Workbooks("book1.xls").Sheets(1) strTitle = UserForm3("TextBox1") i = 1 Do Until .Cells(i, 1) = "" i = i + 1 Loop 'A1から下へ空白がでるまで検索する感じです。 intEndIndex = i - 1 Do Until intTate > intEndIndex If strTitle = "" Then Exit Do ElseIf InStr(1, .Cells(intTate, intYoko), strTitle) > 0 Then End If intTate = intTate + 1 Loop End With End Sub 検索することはできるのですが、 ヒットした行（タイトルや監督や制作年、出演者などが表に書いてある)を別シートに貼り付ける方を教えてください。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBA VLOOKUPについて
エクセル VBA初心者です。 関数でのVLOOKUPをVBAで作りたいのですが、上手くいきません。 あらかじめ、Sheet2の1から300行までに A列 / B列 商品名 / 商品コード が入力されています。(名前の定義=商品コード) Sheet1にユーザーフォームを利用して、データを書き込んだ後、 B列に商品名が書き込まれると、 A列に商品コードが表示されるようにしたいと考えています。 A列に =IF(B2="","",VLOOKUP(B2,商品コード,2,FALSE)) と入力していたのですが、 VBAでIfを使って出来ないかと考えてみたのですが、 上手くいきませんでした。 Private Sub Worksheet_Change(ByVal Target As Range) Dim sRow As Long Dim sColumn As Long sRow = ActiveCell.Row sColumn = ActiveCell.Column If Cells(sRow, 2).Value = True Then Cells(sRow, 1).Value = WorksheetFunction.VLookup(Cells(sRow2).Value, Worksheets("Sheet2").Range("A1:B300"), 2, False) ElseIf Cells(sRow, 2).Value = " " Then Cells(sRow, 1).Value = " " End If End Sub ご教授いただけないでしょうか？ エクセル2003 WindowsXP
- ベストアンサー
- オフィス系ソフト
- Excel VBAについて
Excel VBAについて VBA初心者ですが、作業で使うファイルを使いやすくしようと思っているのですが行き詰ってしまいました。 是非、知恵をお貸しいただきたいと質問させていただきました。 フォームを使ってデータを打ち込むようにしようと思っています。 日付の列を選択するとフォームが立ち上がり、必要項目を記入するというものです。 日付欄が未記入なら「新規」、記入済みなら「修正」 という風にしたいのですが、うまくいきません・・・ 修正しようと入力しなおしても新規として新しい行に書かれてしまいます。 色々と自分で勉強して下のような書き方をしましたが、何がいけないのでしょうか。 ご指摘おねがいいたしますm(__)m Public Sub KAKIKOMI(GYO As Long) GYO = ActiveCell.Row Load UserForm1 With UserForm1 If ((GYO = 17) Or (Cells(GYO, 3).Value = "")) Then GYO = 17 .hiduke.Text = "" .bunnrui.Text = "" .tantou.Text = "" .gaku.Text = "" .memo.Text = "" Else .hiduke.Text = Cells(GYO, 3).Value .bunnrui.Text = Cells(GYO, 7).Value .tantou.Text = Cells(GYO, 8).Value .gaku.Text = Cells(GYO, 9).Value .memo.Text = Cells(GYO, 11).Value .ComboBox1.Text = Cells(GYO, 5).Value End If g_swOK = 0 .Show If g_swOK <> 1 Then GoTo TOUROKU_EXIT If GYO = 17 Then GYO = 19 Do While Cells(GYO, 1).Value <> "" GYO = GYO + 1 Loop End If ActiveSheet.Unprotect Cells(GYO, 3).Value = Trim$(.hiduke.Text) Cells(GYO, 7).Value = Trim$(.bunnrui.Text) Cells(GYO, 8).Value = Trim$(.tantou.Text) Cells(GYO, 9).Value = Trim$(.gaku.Text) Cells(GYO, 11).Value = Trim$(.memo.Text) ActiveSheet.Protect End With End Sub ちなみに、17行目が見出しで、3列目が日付欄です。 よろしくお願いします。
- ベストアンサー
- その他MS Office製品
