二つの条件式を一つにまとめる方法
- マクロを使用して、A列の17行目までの数値をB列に順位として記入する方法を学習しました。しかし、色が付いているセルを空にした後に順位を付ける方法がうまくいきません。Select Case文を使って試みましたが、うまくいかずに困っています。どのようにすれば解決できるでしょうか？
- マクロを使ってA列にある数値をB列に順位で記入する方法を学習しました。しかし、背景色が付いているセルを空欄にした後に順位を付ける方法がうまくいきません。Select Case文を使用してみましたが、うまくいきませんでした。どのようにすれば解決できるのでしょうか？
- マクロを使ってA列にある数値をB列に順位で記入する方法を学びました。しかし、背景色が付いているセルを空にした後に順位を付ける方法が上手くいきません。Select Case文を使用してみたのですが、よく分からなくなってしまいました。どのようにすれば解決できるのでしょうか？
- ベストアンサー
二つの条件式を一つにまとめようとしてます。
二つの条件式を一つにまとめようとしてます。 マクロを勉強しております。以前も質問させて頂いて、やりたい事は解決出来たのですが、更に別の事をしようと思いつまずきました。 A列の17行目まで数値が記入してあり、その順位をB列に記入するマクロを作りました。ここまでは何とか教えて頂いて出来たのですが。 さらに背景色が付いているセルを空欄にしてから順位を出そうとしました。それで、自分なりに記入して出来たのですが、この二つを一つにまとめようとしたらうまくいきません。Select case ～などを使用してみたのですが、よく分からなくなりました。どのようにしたらよいかだれか教えてください。 Sub Macro2() Dim r As Range Range("A1:A17").Select For Each r In Selection If r.Interior.ColorIndex <> xlNone Then r.Value = "" End If Next r End Sub Sub Macro1() Dim r As Range, a As Range Range("A1:A17").Select For Each r In Selection If r.Value <> "" Then r.Offset(, 1).Value = Application.WorksheetFunction.Rank(r, Selection, 1) End If Next r End Sub あと、Select しない書き方も研究してください。と指摘、頂いたのですがまだ未解決なので、そこはそのままになっております。
- konekos
- お礼率80% (40/50)
- オフィス系ソフト
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
Macro2の内容をMacro1の最初に持ってくるだけでいいと思いますが Macro1の条件にr.Value <> "" がありますので Macro2の内容を実行した後でないとその条件でちゃんと検知出来ないでしょう。
関連するQ&A
- 複数行選択して移動するには、どうしたらよいですか？
複数行選択して移動するには、どうしたらよいですか？ たびたび、すみません。 E列に数値が並んでいて、その順位をF列に記述するようにしました。 これで、A,B,C,D列も一緒にG,H,I,J例に記入する方法を教えて頂けませんでしょうか？ 数値が記入されていてA→G、B→H、C→I、D→Jに値だけ移動させたいのですが、すみませんが宜しくお願いします。 Sub Macro1() Dim r As Range, a As Range Range("E1:E17").Select For Each r In Selection If r.Value <> "" Then r.Offset(, 1).Value = Application.WorksheetFunction.Rank(r, Selection, 1) End If Next r End Sub あと、Select しない書き方も研究してください。と指摘、頂いたのですがまだ未解決なので、そこはそのままになっております
- ベストアンサー
- オフィス系ソフト
- ＶＢＡ超初心者です
皆さんのお知恵を拝借させてください。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2007/12/1 ユーザー名 : 101 ' Dim pearend As Integer Dim code As Integer Dim codeend As Integer Dim sheet_name As String Dim dayend As Date Sheets("商品名").Select Range("A4").Select Selection.End(xlDown).Select pearend = Selection.Row() For l = 4 To pearend Step 2 For r = 2 To 3 Cells(l, r).Select code = Cells(l, r).Value Select Case code Case 1000 To 1999 sheet_name = "1000" Case 2000 To 2999 sheet_name = "2000" Case 3000 To 3999 ssheet_name = "3000" Case 4000 To 4999 sheet_name = "4000" Case 5000 To 5999 sheet_name = "5000" End Select Sheets(sheet_name).Select Range("B4").Select Selection.End(xlToRight).Select codeend = Selection.Column() Range("A5").Select Selection.End(xlDown).Select dayend = Selection.Row() For i = 2 To codeend If code = Cells(4, i).Value Then Range(Cells(dayend, i), Cells(5, i)).Select Selection.Copy Sheets("商品名").Select Range("K3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next Next Next End Sub というマクロをつくってみたのですが、何順目かあたりから For r = 2 To 3 のｒがなぜか4になっています。正直知識がないのでさっぱりわかりません。どこに問題があるか詳しい方教えてください。
- ベストアンサー
- オフィス系ソフト
- For Each ～ Nextステートメント
今、1つのブックに200前後のワークシートがあるとします。 For Each ～ Nextステートメントを使って以下のようなプログラムを全てのワークシートに適用したいと考えています。 Sub test() Dim mySht As Worksheet For Each mySht In Worksheets If Range("A2").Value <> "1990/01/31" Then Rows("2:2").Select Selection.Insert Shift:=xlDown Range("A2").Select ActiveCell.FormulaR1C1 = "1990/01/31" End If If Range("A3").Value <> "1990/02/28" Then Rows("3:3").Select Selection.Insert Shift:=xlDown Range("A3").Select ActiveCell.FormulaR1C1 = "1990/02/28" End If ・・・（中略）・・・ Next End Sub しかし、これを実行しても、うまくいきません。 全てのワークシートについて、必ずしもA2のセルが 1990/01/31であるとは限らないことが原因かとは思うんですが、自身ではどうしてもうまくプログラムを書くことが できません。良いお知恵を拝借できればと思います。
- ベストアンサー
- オフィス系ソフト
- 条件の付いた場合の串刺し集計について教えてください
エクセルでワークシート枚数が適当数あり、各シートのA1には0か1の数値が入っています。 また、各シートのA3からA10までは100以下の数値が入っているとします。 一番左側に空のシートを挿入して、A3からA10までを領域選択し、A1の値が1のシートのみ一番左側のシートに串刺し合計したいので以下のようなマクロを組んだのですが、うまくいきません。どこが悪いのかどなたかご指摘してくださいませんでしょうか？ Sub test() Dim i As Integer Dim t As Integer Dim r As Range Worksheets(1).Activate For Each r In Selection For i = 2 To Worksheets.Count Worksheets(i).Activate If Range("A1").Value = 1 Then t = t + r.Value End If Next i Worksheets(1).Activate r.Value = t t = 0 Next r End Sub
- ベストアンサー
- オフィス系ソフト
- Excel2010 VBA 条件色付け
Sub sample() Dim r As Range For Each r In Range("q6:q30") If myIsNumeric(r) Then r.Offset(0, 1).Value = "数字" Else r.Offset(0, 1).Value = "文字" End If Next End Sub Function myIsNumeric(Target As Range) Dim r As Range Dim buf, tmp Dim flg As Boolean Dim i As Integer buf = Target For i = 1 To Len(buf) tmp = Mid(buf, i, 1) If IsNumeric(tmp) Then flg = True Exit For End If Next myIsNumeric = flg End Function を数字が入ってたら塗りつぶさないで、 数字が入ってなかったら塗りつぶすように直したいです。 あああ→塗る あああ1－1→塗らない 住所→塗る 住所12→塗らない
- ベストアンサー
- Excel（エクセル）
- 特定範囲のセルの最終文字1文字を削除
よろしくお願いします。 Sheet1のJ26からJ56の、セルに入れた文字の最終文字1文字を 削除して表示したいのですが、下の構文で、 For Each r In Application.Selectionが黄色くエラー表示されます。 どこをどのように直せばよいのか解りません。 よろしくお願いします。 Private Sub CommandButton1_Click() Dim r As Range r = Worksheets("Sheet1").Range("J26:J56") For Each r In Application.Selection If Len(r.Value) > 0 Then r.Value = Left(r.Value, Len(r.Value) - 1) End If End Sub Next
- ベストアンサー
- Excel（エクセル）
- エクセルVBAの条件指定が上手くいきません
「7を超えたら、For Eachステートメントを抜けなさい」という条件を入れたいのですが、 7を超えても処理が継続し困っています。 勉強不足で申し訳ないですが、ご教授願います。 【やりたいこと】 まず、セルB1～D3までのセルの値（9つ）が、7を超えない条件で1を加算していきます。 加算したときの値はE～Gの列に貼り付けていきます。 7を超えた時点でFor Eachステートメントを抜けます。 また、B1～D3までのセルには計算式が入っており、A1に数字を入れると、 それぞれ異なる増え方をします。（計算式自体は$A$1+1.1、$A$1+2.1などシンプルなもの） Sub test() Dim i As Range Dim n As Long Dim x As Long n = 1 x = 1 For Each i In Range("B1:D3") Range("A1").Value = x If i < 7 Then Range("B1:D3").Copy Cells(n, 5).Select Selection.PasteSpecial Paste:=xlPasteValues n = n + 3 x = x + 1 ElseIf i > 7 Then Exit For End If Next End Sub お手数ですが、宜しくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- 空白セルと０値を識別させたい。（VBA）
すみません、誰か教えていただけますか。 シートの53、54、55行目にそれぞれ値入っています。 それを３行目にビジュアル的に表現させています。 55行目はセルの色で、53行目は数値があり同じ値が 続く部分の合計を出しています。 しかし、下記の記述ですと数値が0（変数D=0）の時に うまくいきません。空白セルと認識されてしまうと思います。 何か、良い方法があれば教えて頂けませんでしょうか。 宜しくお願いします。 Sub 表示() Dim a As Long Dim c As Long Dim D As Long Dim e As String Dim f As String c = 3 For a = 3 To 64 With Worksheets("Sheet1") If .Cells(53, a) <> .Cells(53, a + 1) Then .Range(.Cells(53, c), .Cells(53, a)).Select D = WorksheetFunction.Sum(Selection) e = D f = Selection(1).Offset(1, 0).Value G = Selection(1).Offset(2, 0).Value If D <> 0 Then Selection(1).Offset(-50, 0).Value = f + "//" + e .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.Interior.ColorIndex = G End If If Selection(1).Value = "" Then .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone End If c = a + 1 End If End With Next End Sub
- ベストアンサー
- オフィス系ソフト
- 検索後のセルの選択を正しくしたい
Excel2007でマクロ作成中の初心者です。 以下のコードの中で(1)のところがうまく作動できません。 ここの ActiveCell.Select を正常にするにはどうしたらよいかご教示をお願いします。 Sub 最終日の検索() Dim FC As Range Dim mydate As Date mydate = Range("BQ5").Value For Each FC In Range("BR30:BR300") If FC.Value = DateValue(mydate) Then Exit For End If Next If FC Is Nothing Then MsgBox "みつかりませんここでおわりです" Exit Sub End If MsgBox "見つかりました" & vbLf & FC.Address(0, 0) & vbLf & FC.Value ' ' ここに処理を追加したい ActiveCell.Select ’----------(1) Selection.Offset(0, 45).Select ActiveCell.Select 貼付けしてあるかどうか Set FC = Nothing End Sub ---------------------------------- Sub 貼付けしてあるかどうか() If ActiveCell.Value = "※※" Then MsgBox " 既に貼付けしてあります" Else MsgBox "貼付けしてないので処理します" End If End Sub
- ベストアンサー
- Visual Basic
- RNKU関数をマクロで記述したいのですが？
RNKU関数をマクロで記述したいのですが？ マクロを勉強しようと思いネットや本を見ながら試行錯誤しております。RANK関数と同じことをしようと思い調べながら実行したのですがうまくいきません。型が一致しませんと出るのですが、ヘルプを見ても良く分からなかったので、だれか教えて頂けませんでしょうか。 Sub Macro1() Range("A1:A17").Select For Each r In Selection Range("B1:B17") = Application.WorksheetFunction.Rank(r, Selection, 1) Next r End Sub A列の順位をB列に表示しようとしました。
- ベストアンサー
- オフィス系ソフト
お礼
すみませんすぐに解決できました。難しく考えていました。有難うございます。