- ベストアンサー
VBA 列が空白なら別のマクロへ移動したい
watabe007の回答
A列に Rose の文字が無ければマクロTest2へ If IsError(Application.Match("*Rose*", Columns("A:A"), 0)) Then Call Test2 Exit Sub End If
関連するQ&A
- エクセルのマクロについて
Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア～ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか？できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub
- 締切済み
- オフィス系ソフト
- 複数の列を繋げてＡ列に入れたい ＶＢＡ
aaa aaa bbb aaa bbb ccc aaa (A列にaaa、B列にbbb、C列にcccが入ってます) と言うデータがあるのですが 全てＡ列に入れて aaa aaabbb aaabbbccc aaa としたいです。 ・最終列は必ずしもＣではないのです。（Dの場合もEの場合もある） ・最終行も変化します。 Sub 分かれてる列を繋げる() Dim Col As Long Dim Row As Long For Row = 1 To Range("a65536").End(xlUp).Row For Col = 1 To Cells(Row, 256).End(xlToLeft).Column Cells(Row, 1) = Cells(Row, 1) & Cells(Row, 2) & Cells(Row, 3) Next Col Next Row End Sub をやってみましたが、 aaa aaabbbbbb aaabbbcccbbbcccbbbccc aaa となってしまい、 欲しい結果とは違くなってしまいます。
- ベストアンサー
- オフィス系ソフト
- 列を変更して転記したいのですが。
すみません、誰か教えていただけませんか。 A列に値が入力がされていて、その値をF列に転記していき 15行までいけば２列横にズレて転記していき更に、15行で 2列横と続けたいのですがうまく出来ません。 下記のように記述してみたのですが、値が置き換わるだけで 転記出来ません。 誰か教えて頂けませんでしょうか。 Sub TEST() Dim i As Long, ii As Long Dim myR As Long myR = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row ii = 5 For i = 1 To myR Cells(1, ii).End(xlUp).Offset(0, 1).Value = Cells(i, 1).Value If Cells(1, ii).End(xlUp).Row = 15 Then ii = ii + 2 End If Next i End Sub 宜しくお願いします。
- ベストアンサー
- その他MS Office製品
- 条件による行挿入VBAの統合
Bookごとのデータの内容により次の３つをその都度使い分けていますが これをひとつのVBAに統合したいのですが書き方を教えてください。 (当方詳しくないのでこのVBAも教えられたままのもので自作ではありません） ※A列データのうちタイトル行には■を先頭に入れてあります。 ●「■」があればすべて分割（■タイトルの上の行に１行挿入） Sub 全分割() Dim r As Long For r = 140 To 2 Step -1 If InStr(Cells(r, "A").Value, "■") > 0 Then Rows(r).Insert End If Next End Sub ●タイトルに(1)または(2)が含まれる場合は (1)の上で分割（■の上の行に１行挿入）、(2)のあるA列はセル消去 Sub かっこ２有り分割() Dim r As Long For r = 140 To 2 Step -1 If InStr(Cells(r, "A").Value, "■") > 0 Then If InStr(Cells(r, "A").Value, "(2)") > 0 Then Cells(r, "C").ClearContents End If If InStr(Cells(r, "A").Value, "(1)") > 0 Then Rows(r).Insert End If Cells(r, "A").ClearContents End If Next End Sub ●上記混在の場合（かっこありタイトルとかっこなしタイトルが混在) Sub 混在分割() Dim r As Long For r = 140 To 2 Step -1 If InStr(Cells(r, "A").Value, "■") > 0 Then If InStr(Cells(r, "A").Value, "(2)") > 0 Then Cells(r, "A").ClearContents End If If InStr(Cells(r, "A").Value, "■") > 0 Then Rows(r).Insert End If End If Next End Sub ※かっこ有りに(3)もある場合、(2)と同じ処理 ３つを統合した場合の分類のルール A列に■のあるタイトルの処理 ■のあるタイトルごとにタイトルの上に1行挿入 ただしタイトルに(2)(3)が含まれる場合は、上に行挿入せずそのタイトル部分(A列)のセル消去 A列の状況 ■タイトル データ1 データ2 データ3 ■タイトル(1) データ1 データ2 データ3 ■タイトル(2) データ4 データ5 データ6 ■タイトル データ1 データ2 データ3 A列の処理状況 (行挿入) ■タイトル データ1 データ2 データ3 (行挿入) ■タイトル データ1 データ2 データ3 (空白) データ4 データ5 データ6 (行挿入) ■タイトル データ1 データ2 データ3 なおデータの数字（連番)はD列に入れてありますが、 上記ルールにより■のあとや(2)(3)のとき同一タイトルなら連番にしてあるので この1の行を分割の判定としてもいい Office2013/Windows7
- ベストアンサー
- Excel（エクセル）
- VBAで教えてください。
以前ここで教えていただいたＶＢＡで http://jisaku.155cm.com/src/1371930716_9b9006528605642980beed48a8998013b0731e4b.jpg のようにＡ列のテスト４をクリックしたときにＣ列のテスト４が一発で解るようにしたいです。 もちろん、テスト１１をクリックしたときは、テスト４塗りつぶしは解除され、 テスト１１が塗りつぶされるようにしたいです。 写真は塗りつぶししていますが、解るようにしたいだけなので、塗りつぶしにはこだわっていません。 あと、Ｅ、Ｆ、Ｇ列は解りやすく並べているだけで、実際はＡ、Ｂ、Ｃ列だけです。 それと、Ｃ列は関数を使って表示してあります。 という質問で Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から Dim i As Long Range("C:C").Interior.ColorIndex = xlNone If Application.Intersect(Target, Range("A:A")) Is Nothing Or Target.Count <> 1 Then Exit Sub On Error Resume Next Application.ScreenUpdating = False ActiveSheet.Cells.interio.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, "C") = Target Then Cells(i, "C").Interior.ColorIndex = 3 End If Next i Application.ScreenUpdating = True End Sub 'この行まで をシートのコードに張り付ければいいですよ。と教えてくれたものがあるのですが、 Ａ列でクリックした文字をＣ列からすべて見つけて反転してくれないようです。何個か反転してくれない ものが出てきてしまいました。 Ｃ列が何百行とかなってしまうと、すべての同じ文字を検索してくれないのでしょうか？ ちなみに列がここに掲載しているものと違うので Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から Dim i As Long Range("R:R").Interior.ColorIndex = xlNone If Application.Intersect(Target, Range("B:B")) Is Nothing Or Target.Count <> 1 Then Exit Sub On Error Resume Next Application.ScreenUpdating = False ActiveSheet.Cells.interio.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, "R") = Target Then Cells(i, "R").Interior.ColorIndex = 3 End If Next i Application.ScreenUpdating = True End Sub 'この行まで のＣをＲにＡをＢに変更して使ってます。 これがいけないのかな？ よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBAで列を探して最終行までハイパーリンクを付けた
Ａ列に URL http://oshiete.goo.ne.jp/ http://oshiete.goo.ne.jp/ http://oshiete.goo.ne.jp/ http://oshiete.goo.ne.jp/ http://oshiete.goo.ne.jp/ http://oshiete.goo.ne.jp/ http://oshiete.goo.ne.jp/ http://oshiete.goo.ne.jp/ http://oshiete.goo.ne.jp/ が入ってる場合は、 Sub Sample1() Dim R As Range For Each R In Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row) ActiveSheet.Hyperlinks.Add Anchor:=R, Address:=R.Value Next End Sub でハイパーリンクを付けられますが、 URL列がＡ列じゃない場合の応用の聞かせ方がわかりません。 場合によっては、画像のようにＢ列であったりＣ列であったりします。 なので Dim C As Long C = Cells.Find(What:="URL", LookAt:=xlWhole).Column で列番号を取得して、ループさせようと思ったのですが、 For Each R In Range("a2:a" & Cells(Rows.Count, "a").End(xlUp).Row) の部分でどうすればいいのかわかりません。 range表記ではなくcells表記にすればいいような気がしますがどうやって改造すればいいでしょうか？ あと、この場合はForEachではなくDoloopやForNextを使った方が良いのでしょうか？
- ベストアンサー
- オフィス系ソフト
- 重複行を完全削除するエクセルのマクロ
Sub sakujyo() Dim i, ii As Long For i = 1 To Range("a65336").End(xlUp).Row For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1 If Cells(i, 4).Value = Cells(ii, 4).Value _ And Cells(i, 13).Value = Cells(ii, 13).Value Then Delete Shift:=xlUp End If Next ii 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（エクセル）
- 下記のマクロはC列5行目から文字の
下記のマクロはC列5行目から文字の入っている最後の行までの範囲で セル内に蜜柑や林檎、苺の文字が入っていたら同一行のA列にも蜜、林、苺 の文字を入れるというマクロなのですが・・・ たとえばC列12行目が 『蜜柑林檎苺』 となっていた場合、A列に入る言葉は『苺』となり『蜜』『林』という言葉が 消えてしまいます。 そこでこのマクロを少し改造して、 C列が『蜜柑林檎苺』や『蜜柑苺』となっている場合 A列に入る言葉は『蜜林苺』ないし『蜜苺』という風に積み重ねていくように改造はできないでしょうか？ ↓この部分を改造すればできるようになりますか？ Cells(i, 2).Offset(0, -1).Value = "蜜" Sub 蜜柑林檎苺() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "蜜柑") > 0 Then MsgBox i & "行目アウト！" Cells(i, 2).Offset(0, -1).Value = "蜜" End If If InStr(.Cells(i, "C"), "林檎") > 0 Then MsgBox i & "行目アウト！" Cells(i, 2).Offset(0, -1).Value = "林" End If If InStr(.Cells(i, "C"), "苺") > 0 Then MsgBox i & "行目アウト！" Cells(i, 2).Offset(0, -1).Value = "苺" End If Next i End With End Sub
- ベストアンサー
- オフィス系ソフト
- VBAで別の列のセルにも色付け～２
WINDOWS XP EXCELL ２００３です。 いつもお世話になります。 ご迷惑とは重々と承知しながら再度質問させていただきます。 １ 御指導を賜りたいのは、 現在A列には月度を示す ０１～１２ が入力され月別にセルの背景色を塗りつぶしていますがこれをA列用のマクロを工夫してF列にも同様に適用したい。 例えば参照図で言うと A７ ０５ ピンク A８ ０５ ピンク A９ ０６ ライトブルー A１０ ０７ 草色 等のように ※ 参照図のF列のセルには背景色は適用していません。 ２ 参照図のそれぞれの設定は、 ※ 計画 と 生産はセル位置だけの違いで生産の方は割愛します。 D１ ユーザー定義 mm/dd D２ ユーザー定義 ２０００００ D３ 数値 A７ ユーザー定義 mm マクロ ボタン「計画入力」 Sub 計画入力() Dim GYOU '追加 GYOU = Range("C65536").End(xlUp).Row + 1 Cells(GYOU, 2).Value = Range("D1").Value Cells(GYOU, 3).Value = Range("D2").Value Cells(GYOU, 4).Value = Range("D3").Value End Sub ボタン「セルセット」 Sub 計画セル() Range("D1,D2,D3,D1").Select End Sub A列のセル塗りつぶし Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 8 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, 0).Value = Date End If Dim c As Integer If Target.Column <> 2 Then Exit Sub If Target.Value = "" Then c = 0 Else On Error GoTo line Select Case Month(Target.Value) Case 1: c = 46 Case 2: c = 4 Case 3: c = 39 Case 4: c = 6 Case 5: c = 7 Case 6: c = 8 Case 7: c = 43 Case 8: c = 3 Case 9: c = 44 Case 10: c = 24 Case 11: c = 40 Case 12: c = 17 End Select End If Target.Offset(0, -1).Interior.ColorIndex = c Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0) Exit Sub line: Target.Offset(0, -1).Interior.ColorIndex = 0 Target.Offset(0, -1).Font.ColorIndex = 0 End Sub 御指導よろしく御願いします。
- ベストアンサー
- その他MS Office製品
お礼
ご回答ありがとうございました。 日中に職場でテストして完璧に動くことが出来ました！ 今週中に締切の仕事だったので、今日中に解決出来て本当に助かりました。大感謝です！