- ベストアンサー
指定範囲内のカウント方法とは？
- B2～任意の行列に書かれている"済"という単語の数を数えるマクロを作成しています。
- 1列のみであれば、動作しますが、任意の列の指定がうまくいかず困っています。
- 聞くばかりになってしまって申し訳ありませんが、どのようにすれば列も任意の箇所にすることができるでしょうか？
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- エクセルVBA プルダウンのリスト 指定範囲以外で
こんにちは。 現在、業務で案件の簡単な進捗表を作成しています。 VBAで他の、ご質問/回答を基にマクロを組んで遊んで？いますが、 以下の問題に困っています。 現在作成中のエクセルファイルのステータスですが、 (1)A列に”入力規則”でプルダウン（終了,延期）を設けています。 (2)マクロでA列のプルダウンで”終了”の場合はA:AFまでグレーアウト 同様に”延期”の場合はA:AFまで黄色 (3)マクロでC列に”土”ならフォントを青で日なら赤 やりたい事ですが、 (1)の事を”マクロ”でやりたいんです。 リストで元の値を指定してマクロを組む方法は、 いくらでもネット上に転がっているのですが、 元の値を範囲ではない方法、つまり、 入力規則⇒リスト⇒ ”=$A$1:$A$10” ではなく、”りんご,ばなな、みかん”のように、 マクロのコード内で範囲を構成したい、、、 うまくいえませんが、簡単に言うと、プルダウンメニューが2つしかないのに、 わざわざ、データ用の別シートを作ったりしたくない、、、という理由です。 このプルダウンメニューのマクロを今の下記コードに組み込ませたいのですが、 どなたか、ご教授願います。 ※今後の事も考え拡張性（プルダウンメニューの追加とか）を考慮したものを書きたいです。 マクロが面白くなってきたから勉強しているのであって、 入力規則の今のままでいいのでは？という野暮な回答はご遠慮します。 上記の(2)と(3)を他の質問から見よう見まねで組み合わせ、 動作は確認出来ています。 以下が組み合わせたものとなります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim RngA1 As Range Dim RngA2 As Range Dim RngC1 As Range Dim RngC2 As Range Dim RngE1 As Range Dim RngE2 As Range Dim rr As Range Dim i As Long Dim c As Range Dim myColor As Long Dim clr As Integer '#########################Ａの処理######################### Set RngA1 = Range("A:A") '判定の対象となる列 Set RngA2 = Range("A:AF") '色を変える列 If Intersect(Target, RngA1) Is Nothing Then GoTo SYORI_C For Each c In Intersect(Target, RngA1) With c Select Case .Value Case "終了": myColor = 48 Case "延期": myColor = 27 Case Else myColor = xlColorIndexNone End Select Intersect(c.EntireRow, RngA2).Interior.ColorIndex = myColor End With Next '#########################Cの処理######################### SYORI_C: Set RngC1 = Range("V:V") '判定の対象となる列 Set RngC2 = Range("V:W") '色を変える列 If Intersect(Target, RngC1) Is Nothing Then GoTo SYORI_E For Each c In Intersect(Target, RngC1) With c Select Case .Value Case "無し": myColor = 48 Case Else myColor = xlColorIndexNone End Select Intersect(c.EntireRow, RngC2).Interior.ColorIndex = myColor End With Next '#########################Eの処理######################### SYORI_E: Set RngE1 = Range("X:X") '判定の対象となる列 Set RngE2 = Range("X:Y") '色を変える列 If Intersect(Target, RngE1) Is Nothing Then GoTo SYORI_G For Each c In Intersect(Target, RngE1) With c Select Case .Value Case "無し": myColor = 48 Case Else myColor = xlColorIndexNone End Select Intersect(c.EntireRow, RngE2).Interior.ColorIndex = myColor End With Next '######################################################## SYORI_G: If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub For Each rr In Intersect(Target, Range("C:C")) For i = 1 To Len(rr.Value) Select Case Mid$(rr.Value, i, 1) Case "土": clr = 5 Case "日": clr = 3 Case Else: clr = xlAutomatic End Select rr.Characters(i, 1).Font.ColorIndex = clr Next Next '######################################################## End Sub
- 締切済み
- その他MS Office製品
- VBAでオートフィルを使って指定する文字列を含むものを表示させたい
VBAを使って、セルD1に入力した文字列を検索するマクロを作りたいと思っています。 私は初心者で前に似たようなものを作ってもらって それを加工しようとしたのですが、うまくいきませんでした。 以前は完全に一致するもので表示でしたが、 今回は含むものを表示させたいです。 ワイルドカードは＊をつけるのはわかるのですが、 いろいろやってみましたがダメでした。（単純なことかもしれないですけど） Private Sub Worksheet_Change(ByVal Target As Range) Dim myRng1 As Range Dim myRng2 As Range Set myRng1 = Target.Cells(1) If Application.Intersect(myRng1, Range("D1")) Is Nothing Then Exit Sub Set myRng2 = Range("D1").CurrentRegion With myRng2 If myRng1 = "" Then ActiveSheet.ShowAllData Else .AutoFilter Field:=4, Criteria1:=myRng1.Value End If End With End Sub
- 締切済み
- その他（プログラミング・開発）
- EXCELで印刷範囲指定
マクロの記録で印刷範囲の指定を考えています。 以下のマクロを記録しました。 Sub 印刷範囲指定() Cells.Select With Selection.Font .Name = "ＭＳ Ｐゴシック" .Size = 9 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("A1").Select With ActiveSheet.PageSetup .PrintTitleRows = "$6:$8" .PrintTitleColumns = "" End With ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "&A" .RightHeader = "" .LeftFooter = "" .CenterFooter = "&P / &N ページ" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.78740157480315) .RightMargin = Application.InchesToPoints(0.78740157480315) .TopMargin = Application.InchesToPoints(0.984251968503937) .BottomMargin = Application.InchesToPoints(0.984251968503937) .HeaderMargin = Application.InchesToPoints(0.511811023622047) .FooterMargin = Application.InchesToPoints(0.511811023622047) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .PrintQuality = 600 .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 End With ActiveWindow.View = xlPageBreakPreview ActiveWindow.LargeScroll ToRight:=1 ActiveSheet.PageSetup.PrintArea = "$A$1:$I$50" ActiveWindow.View = xlNormalView Columns("B:I").Select Columns("B:I").EntireColumn.AutoFit Range("A1").Select End Sub やりたいことは ・まず最初にcsvファイルをxlsファイルに取り込む機能をつけたい。 ・取り込んだcsvをシートの一番最後につける。 そのファイルを以下のように設定していきたいです。 ・列の印刷範囲を数ある列のうちA列からI列までとする。 ・行の印刷範囲をA列の最終行までとしたい。 上記マクロでここを修正すればいいというところがあれば教えてください。。
- 締切済み
- オフィス系ソフト
- VBA 範囲選択時エラー
Private Sub Worksheet_SelectionChangeのVBAでA列B列C列でワンクリックで文字が入力できるように設定致しました。 その後、A列からC列を範囲選択してDeleteするとデバック 「実行時エラー 型が一致しません」と出てしまいます。業務上、そのセルのデータは一気に消したいので困っております。どなたか分かる方よろしくお願い致します。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range, rng_1 As Range, rng_2 As Range Application.EnableEvents = False Set rng_1 = Range("H17:H100") Set rng_2 = Range("I17:I100") Set rng_3 = Range("J17:J100") Set rng_4 = Range("K17:K100") Application.EnableEvents = True Set rng = Intersect(Target, rng_1) If Not rng Is Nothing Then Cancel = True If Target.Value = "" Then Target.Value = "(1)" Else Target.Value = "(1)" End If Else Set rng = Intersect(Target, rng_2) If Not rng Is Nothing Then Cancel = True If Target.Value = "(2)" Then Target.Value = Empty Else Target.Value = "(2)" End If Else Set rng = Intersect(Target, rng_3) If Not rng Is Nothing Then Cancel = True If Target.Value = "(3)" Then Target.Value = Empty Else Target.Value = "(3)" End If Else Set rng = Intersect(Target, rng_4) If Not rng Is Nothing Then Cancel = True If Target.Value = "(4)" Then Target.Value = Empty Else Target.Value = "(4)" End If End If End If End If End If End Sub
- 締切済み
- Visual Basic
- 指定範囲をアクティブセルに変更(エクセル)
以下のマクロで、A1:E20にある全ての図形を削除できます。 Sub test() Dim wLeft As Long Dim wTop As Long Dim wRight As Long Dim wBottom As Long Dim s As Object With Range("A1:E20") wTop = .Top wLeft = .Left wBottom = .Top + .Height wRight = .Left + .Width End With For Each s In ActiveSheet.DrawingObjects With s If wTop <= .Top And _ wLeft <= .Left And _ wBottom >= .Top + .Height And _ wRight >= .Left + .Width Then .Delete End If End With Next End Sub "With Range("A1:E20")"を、任意のアクティブセルに変更するにはどうすればいいでしょうか？ ちなみに、"With ActiveCell"や"With Range(ActiveCell.Address)"では、うまくいきませんでした。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAのイベントで質問です。
ダブルクリックイベントで、G12:G31の範囲の文字列をB10:B27の範囲(最下行)に入れていくものを使っていますが、新たにH12:H31にある文字列もダブルクリックするとC10:C27の範囲(最下行)に入れていけるようにしたいと思います。 どのようにすればいいでしょうか。 ご存知の方いらっしゃればお教えいただけると助かります。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, _ Cancel As Boolean) Dim i As Long Dim flg As Boolean If Intersect(Target, Range("G12:G31")) Is Nothing Then Exit Sub If IsEmpty(Target.Value) Then Exit Sub With Worksheets("シートＡ") For i = 10 To 27 If .Range("B" & i).Value = "" Then .Range("B" & i).Value = Target.Value flg = True Exit For End If Next i If flg = False Then MsgBox .Name & " がいっぱいです。" End If End With Cancel = True End Sub
- ベストアンサー
- オフィス系ソフト
- オブジェクトが定義されていません
以下のコードを実行すると「オブジェクトが定義されていません」とエラー表示されます。 オフィス2003、エクセルＶＢＡです。 Withの使い方がまちがっているのでしょうか？ 分かる方教えてください。 お手数をおかけしますがよろしくお願いします。 intGyou = Int(intDeley(i) * 2) With ThisWorkbook.Sheets(\"default\") If intDeley(i) = 0 Then .Range(\"Y7:Y1446\").Copy _ .Range (\"Z7:Z1446\") Application.CutCopyMode = False Else .Range(.Cells(intGyou + 7, 25), .Cells(1446, 25)).Copy _ .Range (\"Z7\") .Range(.Cells(7, 25), .Cells(intGyou + 6, 25)).Copy _ ThisWorkbook.Sheets(\"default\").Range(.Cells(1447 - intGyou, 26), .Cells(1446, 26)) Application.CutCopyMode = False End If End With
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで値のカウントをしたい
C列～AA列まで値が入っています 1行目にはタイトル 2行目からそれぞれ値が入っており、終了行は毎回ランダムです 各列毎に値の合計と1以上の値の合計数を表示するために下記のマクロを使用しているのですが、もっとスマートな方法は無いでしょうか？ 現在のマクロだとマクロ行数がとても多いものになっています。 Sub Count() With Range("C2") .End(xlDown).Offset(1, 0) = _ "=SUM(" & Range(.Address, .End(xlDown)).Address(False, False) & ")" End With '本当はCの最終行に直接COUNTIFを書き込みたいが、他のセルを使用しないと0になる Range("A1") = "=COUNTIF(C2:C10000,"">=1"")" Range("A1").Select Selection.Copy Range("C1").End(xlDown).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CommandBars("Stop Recording").Visible = False With Range("D2") .End(xlDown).Offset(1, 0) = _ "=SUM(" & Range(.Address, .End(xlDown)).Address(False, False) & ")" End With Range("A1") = "=COUNTIF(D2:D10000,"">=1"")" Range("A1").Select Selection.Copy Range("D1").End(xlDown).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CommandBars("Stop Recording").Visible = False '以降AAまでセルの位置を変えた同一マクロを繰り返す End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルのマクロコードについて
お世話になります。 下記コードで、セルごとにクリアをすると、エラーなくうごくのですが、セルをまとめてセルを消すと実行時エラー13型が一致しません。とでてIf Target.Value = "" Thenがだめだよとでてしまいます。 どなたか、回避の方法をご教授ください。 宜しくお願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("B2:E2,G2:J2")) Is Nothing Then Exit Sub If Target.Value = "" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo 'Range("B2").Value = x + Z Z = Target.Offset(1, 0).Value y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With Target.Offset(1, 0).Value = x + Z End Sub
- ベストアンサー
- Excel（エクセル）
- 他ブックから指定範囲をコピー
自分で調べたのですがよく分からないので質問します。 下のように書いたのですが 実行時エラー '424'; オブジェクトがッ必要です。というエラーが出ます。 Private Sub CommandButton3_Click() Dim F_Name As String, myRange As Range F_Name = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If F_Name <> "False" Then Workbooks.Open F_Name With ActiveWorkbook Set myRange = .Worksheets(1).Range("B6:U509") .Saved = True .Close End With With ThisWorkbook myRange.Copy.Worksheets(2).Range ("B6:U509") End With End If Set myRange = Nothing End Sub やりたいことは読み込んだExcelのシート１（または金額というシート）のB6:U509範囲をコピーし 実行したブックのシート２（または金額というシート）のB6:U509範囲に貼り付けたいのです。 よろしくお願いします
- 締切済み
- オフィス系ソフト
お礼
さっそくのご回答ありがとうございます。 おかげさまで、最右列を指定することができました。 これを使って、列ごとの"済"をカウントするには どうすればいいのでしょうか？ A B C D … 済 済 済 済 合計 2 1 1 … のように行いたいのですが… ※合計が最下行になります よろしくお願いします
補足
すいません。 自己解決しました。 ありがとうございました。