エクセルVBAでA列を基準にBC列を更新する処理
- エクセルVBAを使用して、A列を基準にBC列を更新する処理を作成したい場合、以下のコードを使用します。
- コードでは、A列が数値以外の場合は処理をスキップし、次の行に進むようになっています。
- また、BC列が空白の場合はAの数値を入れ、A>Bの場合はB列を更新し、A<Cの場合はC列を更新します。
- ベストアンサー
エクセルVBA
A列を基準にBC列が空白ならAの数値を入れて、A>BならB列を更新、A<CならC列を更新 A列が数値以外ならその行をスキップ、という処理をしたいのですが Option Explicit Dim A As Range, B As Range, C As Range Dim i As Long Sub test() For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A) Then Else Exit Sub End If If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value Next i End Sub とすると数値以外の行の時点で停止してしまいます。 その行を飛ばして次の行に進むにはどうしたらいいのでしょうか？
- abcii2k
- お礼率50% (1/2)
- Visual Basic
- 回答数2
- ありがとう数1
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
以下の部分でそのような処理にしているからです。 If IsNumeric(A.Value) Then→数値だった場合 →なにもしない。 Else→それ以外の場合（数値以外）は Exit Sub→サブルーチンを抜ける。 End If こんな感じです。 正しくは、 For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A.Value) Then If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value End If Next i でよいと思います。
その他の回答 (1)
- osamuy
- ベストアンサー率42% (1231/2878)
試してませんが、こうとか： Sub test() Dim A As Range, B As Range, C As Range Dim i As Long For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) Debug.Print i; ": IsNumeric("; A.Address; ")="; IsNumeric(A) If IsNumeric(A) Then If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value End If Next i End Sub
関連するQ&A
- ＶＢＡ(エクセル）でのＣＯＵＮＴＡについて
エクセルのＳｈｅｅｔ１のＢ列にＳｈｅｅｔ２の内容をコピーして、(ここまではできました） Ｓｈｅｅｔ１のＢ列に入ってきたデータの横（Ａ列に）連番を振りたいと思っています。 そのため、以下のように作ってみたのですが、 Ａ列に表示される連番が現在のＢ列の最後の数“５４”をＡ列全て(Ｂ列にデータがあるところ）に表示してしまいます。 どの部分が悪いのかさっぱりわからず、どのように修正すべきかもわからず・・・困ってしまっています。 よろしくお願いします。 Dim i As Range Dim mycount As Range Set mycount = Application.Intersect(Target, Me.Range("b:b")) If mycount Is Nothing Then Exit Sub End If Application.EnableEvents = False For Each i In mycount If IsEmpty(i.Value) Then i.Offset(0, -1).ClearContents Else i.Offset(0, -1).Value = Application.WorksheetFunction.CountA(Range("b2:b200")) End If Next i Application.EnableEvents = True End Sub
- ベストアンサー
- オフィス系ソフト
- VBAの記録を追加したい
エクセル2002使用です。 VBAで次のコードを使っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Set Target = Intersect(Range("C:C"), Target) If Target Is Nothing Then Exit Sub For Each Rng In Target If Rng.Value <> "" Then Rng.Offset(, -2).Value = Now Else ' (*) Rng.Offset(, -2).Value = "" ' (*) End If Next Rng End Sub （C列のセルに何か入力されると、A列の同じ行にその時刻が入る。） 同じシートで、F列に何か入力されるとE列の同じ行にその時刻が入るように書き直したいのですが、どうすればいいのでしょうか？ すいませんが、よろしくお願いします。
- ベストアンサー
- Visual Basic
- VBAの処理を軽くしたい
各行ごとに5回セルを参照した結果を吐き出すプログラムを作成しています。 200行前後の処理が必要なのですが、現在のコードではあまりにも処理が重くなっています。 とにかく処理を軽くしたいのですが、どのような方法が考えられるでしょうか？ 初心者なのでコードも含めてご教示頂けたら幸いです。 Sub test(b, c, d) Dim i1, i2 As Long Dim A1 As String For i1=0 To Cells(Rows.Count, 1).End(xlUp).Row For i2 = 0 To 5 If Range(b).offset(i1, i2).Value = "x1" Or Range(c).offset(i1, i2).Value = "x1" Then A1 = "XXX" ElseIf Range(b).offset(i1, i2).Value = Range(c).offset(i1, i2).Value Then A1 = "YYY" Else A1 = "ZZZ" End If Range(d).offset(i1, i2).Value = A1 Next i2 Next i1 End Sub
- ベストアンサー
- その他MS Office製品
- エクセルVBAで表から行の削除
添付画像のような表があります。 表はB列の名前でソートされています。 D列の比率をみて、100でないものは、必ず同じ名前で複数行にわかれ合計で100になります。この例では名前CとEとHがそうです。 同じ名前が複数行にわかれている場合、最大の比率の行を残し、他の行（例では、埼玉、栃木、長野、新潟の行）を削除したいのです。 複数行にわかれるのが名前CやEのように2行なら、以下のコードで出来ました。 しかし、めったにはありませんが名前Hのような3行以上に分かれるものには対応できません。 どうすればよいでしょうか？ Sub test01() Dim c As Range Dim Rng As Range Set Rng = Range(Cells(2, "D"), Cells(Rows.Count, "D").End(xlUp)) For Each c In Rng '2地区の分担の場合、分担比率高い方を残す。（3地区以上は未対応）2012/08/29 If c.Value <> 100 And c.Offset(1).Value <> 100 Then If c.Offset(, -2).Value = c.Offset(1, -2).Value Then If c.Value >= c.Offset(1).Value Then c.Offset(1).Value = False Else c.Value = False End If End If End If Next If Application.WorksheetFunction.CountIf(Rng, False) > 0 Then Rng.SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete End If End Sub
- ベストアンサー
- その他MS Office製品
- エクセル VBA の質問です。
A2～A20までのセルに文字を入力した段階で、それぞれB2～B20に入力日時を入れるVBAを以下のように組んでいます。 しかし、同様の条件を同一シートのE2～E20・F2～F20にも入力・自動表示できるようにしなければならなくなり、困っています。 どのように記述を変えればよいのか、教えていただけたらと思います。 宜しく御願いいたします。 Sub Worksheet_change(ByVal Target As Range) Dim Rng As Range Dim c As Range Set Rng = Range("A2:A20") If Intersect(Target,Rng) Is Nothing Then Exit Sub For Each c In Intersect(Target,Rng) If Not IsEmpty(c) Then c.Offset(, 1).Value = Now Else c.Offset(, 1).ClearContents End If Next Rng.Offset(, 1).EntireColumn.AutoFit End Sub 申し訳ありませんが、何卒、宜しく御願いいたします。
- ベストアンサー
- オフィス系ソフト
- Excel UserForm ListBox
Excel UserForm ListBoxの表示についての質問です Sheets("加工").Range("A44")からRange("G" & LastRow)のセルの値を Form_receipt.ListBox1に表示させたいのですが C～E列は数値なので桁数区切りで表示したくてマクロを作ったのですが Ａ列１列しか表示されないマクロになってしまいました。 どこが悪いのかご教示願えませんか？ あわせてC～E列を右揃えでリスト表示する方法も教えてください 失敗作のマクロは以下です Sub Macro48() Form_receipt.ListBox1.Clear Sheets("加工").Select '配列の定義 Dim myRng As Range Dim myList As Variant Dim c As Variant Dim i As Integer Dim j As Integer Dim LastRow As Integer For j = 45 To 94 If Sheets("加工").Range("A" & j).Value = "" Then Exit For End If Next j If Sheets("加工").Range("A47").Value = "" Then LastRow = j - 1 Else LastRow = 46 End If Set myRng = Range("A44", Range("A" & LastRow)) ReDim myList(myRng.Rows.Count - 1, 7) For Each c In myRng myList(i, 0) = c.Offset(, 0).Value myList(i, 1) = c.Offset(, 1).Value myList(i, 2) = Format$(c.Offset(, 2).Value, "@@@,@@@,@@@") myList(i, 3) = Format$(c.Offset(, 3).Value, "@@@,@@@,@@@") myList(i, 4) = Format$(c.Offset(, 4).Value, "@@@,@@@,@@@") myList(i, 5) = c.Offset(, 5).Value myList(i, 6) = c.Offset(, 6).Value myList(i, 7) = c.Offset(, 7).Value i = i + 1 Next c Form_receipt.ListBox1.List() = myList Set myRng = Nothing 'リスト表示幅設定 With Form_receipt.ListBox1 .ColumnWidths = "30,0,60,60,60,150,50" End With Form_receipt.Show End sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAの書き方で教えてください。
エクセルで、 「A列にデータを入力した日付をB列に自動で入れる」 （A列のデータを消したときは、B列のデータも消える）ということをするのに、 他の質問を参考にして、 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then '対象の列が1列目(A列)なら If Target.Value <> "" Then '入力された値がブランクでなければ Target.Offset(0, 1).Value = Date '0行ずれた(同じ行）の1列右隣に日付を入れる Else 'そうでなければ(Deleteキーで消されたら） Target.Offset(0, 1).Value = "" '同行右隣をブランクすなわち""として消す End If '入力された値の処理終り End If '1列目(A列）の処理終り、従ってB列以降はチェックしない End Sub と、入力して、うまく動きました。 ところが、「A列に入力」→「B列に自動で日付」だけでなく、 「D列に入力」→「E列に自動で日付」 「H列に入力」→「I列に自動で日付」と、1つのエクセルシートの中で いくつかの同じ条件のことを繰り返そうと思うとうまくいきません。 この場合、どのようにVBAを記入したら良いのか、教えてください。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBA
Sub PlusA001() Dim a As Range Dim b As Integer Range("e1").Value = "氏名" Range("e2").Value = "甲" Range("e2").AutoFill Destination:=Range("e2:e10"), Type:=xlFillDefault Range("f1:j1").Value = Array("国", "数", "理", "社", "英") Set a = Range("f2") For i = 1 To 5 Do Until b = 9 a.Value = Int(100 * Rnd) + 1 b = b + 1 Set a = a.Offset(1, 0) Loop b = 0 Set a = a.Offset(-9, 1) Next i End Sub サンプルコードの例ですが、どうも実行しても納得できない部分があります。それはSet a=a.offset(-9,1)の部分です。Set a = Range("f2")においてf2を始点としているのは判りますが、ｆ２からであればa=a.offset（－９、５） とすればいいのかと思い実行したのですが、ぐちゃぐちゃになります。なぜ（－９、５）ではなく（－９、１）何ですか？いくら読み解いても判りません。教えてください。
- ベストアンサー
- Visual Basic
- エクセルの簡単なマクロ機能を追加したいのです
既存のエクセルマクロ（Sub チェック()以下です）に下記の内容のマクロを付け足したいです。 教えていただけないでしょうか。 付け足したい条件です： Sheet2のC列に 0 があれば Sheet1のB列に 愛 と（[太字]でセルの背景色を[灰色25%]にして）入れたいです 恐れ入りますがご存じの方がいらっしゃりましたら教えていただきたく何卒よろしくお願いいたします。 ----------------------------------------------- Sub チェック() Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim myRange1 As Range Dim myRange2 As Range Dim c1 As Range Dim c2 As Range Dim myCt As Long Set Ws1 = Worksheets("Sheet1") Set Ws2 = Worksheets("Sheet2") Set myRange1 = Ws1.Range("A1", Ws1.Cells(Rows.Count, "A").End(xlUp)) Set myRange2 = Ws2.Range("A1", Ws2.Cells(Rows.Count, "A").End(xlUp)) For Each c1 In myRange1 myCt = 0 For Each c2 In myRange2 If c2.Value = c1.Value Then If c2.Offset(, 1).Value = "" Then c1.Offset(, 1).Interior.ColorIndex = 3 Else c1.Offset(, 1).Value = c2.Offset(, 1).Value End If myCt = myCt + 1 End If Next c2 If myCt > 1 Then c1.Offset(, 1).Interior.ColorIndex = 10 Next c1 Set Ws1 = Nothing Set Ws2 = Nothing Set myRange1 = Nothing Set myRange2 = Nothing End Sub
- 締切済み
- その他MS Office製品
- エクセルVBAについて
エクセルVBAについて 下にある、1行目に入力された数値の、選択したセルの数値を、Ｂ５セルに表示させるマクロなのですが、1行目が結合していると、うまくＢ５セルに表示できません。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub '●複数セル選択は無視 If Target.Row <> 1 Then Exit Sub '●１行目以外の選択は無視 If Target.Column > 6 Then Exit Sub '●Ｆ列目以降の選択は無視 If Target.Value = "" Then Exit Sub '●選択セルが未入力なら無視 Range("B5").Value = Target.Value End Sub このマクロで、結合しているセルをＢ５に表示させることはできますでしょうか？ 1行目で選択するセルは、すべて2つのセルが結合しています。 よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
お礼
できました、すぐに回答してくださってありがとうございます。