• 締切済み

A2の値がA1の値と同じ場合はB2にB1の値+1をして

A2の値がA1の値と同じ場合はB2にB1の値+1をして A2の値がA1の値と違う場合はB2に"1"を繰り返しさせて入力するように 以下としたのですが、A列の値がなくなる限り1が入力されるだけなのですが どうすれば、A列のセルに同じ値が続く場合連番とすることができるでしょうか。お願いします。 range("B1").value = 1 range("B2").select dim 番号 As varient 番号 = activecell.offset(-1, -1).value do until activecell.offset(0,-1).value = "" with activedell if offset(0, -1).value = 番号 then offset(0, 0).value = offset(-1, 0).value + 1 end if offset(0, 0).value = "1" offset(1, 0).select end with loop

みんなの回答

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

だいたいこんなOFFSETを使って処理する(判別する)セルをずらすやり方はつかいませんよ。 本質問が解決したら、また別の機会に ●For Nextを使いiを行ポインターとして処理します。 ●do until なら行ポインターとしてi=i+1として次々処理します。 エクセルVBAの(ビジネス系の)本などみて勉強してください。 それに質問にコードを貼り付けるなら、VBEの画面(1度は実行後の)をコピー貼り付けしては。 本質問のようにミスタイプがあると、それ(文法的な)が原因か他の原因か判りにくくなりますよ。 varient activedell offset(0, 0)の前のピリオド無し など ーー Activecellも危ういと思う。実行時にたまたま意図以外のところがアクチブ担っていたら データがめちゃめちゃになる場合もある。 VBAで変えてしまった値の、前戻しが出来ない。

  • goo39
  • ベストアンサー率36% (13/36)
回答No.2

VariantやActiveCellのスペルミスがありますが 1が入力されると言う事なのでそこはスルーして end ifの箇所が悪いようです。 end if offset(0, 0).value = "1"  ↓ Else .Offset(0, 0).Value = "1" End If のようにして下さい。

回答No.1

With内をよく見てください! 「.」が抜けてます .Offset(0,-1).Value***** となります

関連するQ&A

  • 連続印刷処理前に確認しOKしてから再開するマクロ

    連続印刷マクロを作成したのですが、印刷の手前で確認を入れたいので、その処理を教えてください。 エクセルの表は項目が14列あり、999行です。 印刷は、2種類のシートに分け印刷できるようになっているのですが、確認は1度だけを考えています。 Sub 印刷_Click() Worksheets("集計・印刷").Activate '作業シート名 Range("A2").Select '番号(001~999)をこの次の"A3"セルより転記される。 Do '↓ ※1度の作業で15個の番号を最大とします。 'アクティブセルを1つ下に移動 ActiveCell.Offset(1, 0).Select '1度の作業で15枚印刷する。 '空欄であれば、プログラムを終了する 'Trim関数は前後のスペースを消去する If Trim(ActiveCell.Value) = "" Then Exit Do End If '非表示セルは印刷の対象としない If ActiveCell.EntireRow.Hidden = False Then If ActiveCell.Offset(, 2).Value = "単品" Then 'C列で単品の判断をする。 With Worksheets("A") 'Aシートへ記入 .Range("C3").Value = ActiveCell.Offset(0, 0).Value '番号 .Range("L24").Value = ActiveCell.Offset(0, 2).Value '種類 .Range("F3").Value = ActiveCell.Offset(0, 3).Value '型式 .Range("C23").Value = ActiveCell.Offset(0, 4).Value '測定日 .Range("C24").Value = ActiveCell.Offset(0, 5).Value '製造日 .Range("C9").Value = ActiveCell.Offset(0, 6).Value 'ライン .Range("C10").Value = ActiveCell.Offset(0, 7).Value '担当 .Range("C7").Value = ActiveCell.Offset(0, 9).Value '外観 .Range("C8").Value = ActiveCell.Offset(0, 10).Value '気密 '繰返し処理をしているので一度に印刷される。 .PrintOut End With ElseIf ActiveCell.Offset(, 2).Value = "複数品" Then'C列で複数品の判断をする。 With Worksheets("B") 'Bシートへ記入 .Range("C3").Value = ActiveCell.Offset(0, 0).Value '番号 .Range("L24").Value = ActiveCell.Offset(0, 2).Value '種類 .Range("F3").Value = ActiveCell.Offset(0, 3).Value '型式 .Range("C23").Value = ActiveCell.Offset(0, 4).Value '測定日 .Range("C24").Value = ActiveCell.Offset(0, 5).Value '製造日 .Range("C9").Value = ActiveCell.Offset(0, 6).Value 'ライン .Range("C10").Value = ActiveCell.Offset(0, 7).Value '担当 .Range("C7").Value = ActiveCell.Offset(0, 9).Value '外観 .Range("C8").Value = ActiveCell.Offset(0, 10).Value '気密 .Range("C11").Value = ActiveCell.Offset(0, 23).Value '(1)min .Range("C12").Value = ActiveCell.Offset(0, 24).Value '(1)max .Range("F7").Value = ActiveCell.Offset(0, 25).Value '(2)min .Range("F8").Value = ActiveCell.Offset(0, 26).Value '(2)max '繰返し処理をしているので一度に印刷される。 .PrintOut End With End If End If Loop End Sub

  • 条件で印刷シートを別けたい。

    データシート"みかん・りんご"に入力データがあり、"C列の'りんご(特定)''りんご(その他)''みかん(特定)''みかん(その他)'を検索。 (特定)がついているのは"D列"産地ごとにシート別に記入し、印刷をしたいのです。 ifを使っても2条件しか識別できないので、困っています。 りんご(長野)、りんご(青森)、りんご(その他)の3種類。 みかん(和歌山)、みかん(愛媛)、みかん(静岡)、みかん(その他)の4種類。 別々のシートに入力し印刷するにはどうしたら良いか教えてください。 コマンドボタンは1つにこだわりはないです。(エクセルの添付画面には、1つしかつけてないですが) 途中まで作成したマクロを載せています。 Range("A2").Select '仕入れ番号をこの次の"A3"セルより転記される。 Do '↓ 'アクティブセルを1つ下に移動 ActiveCell.Offset(1, 0).Select '空欄であれば、プログラムを終了する 'Trim関数は前後のスペースを消去する If Trim(ActiveCell.Value) = "" Then Exit Do End If '非表示セルは印刷の対象としない If ActiveCell.EntireRow.Hidden = False Then If ActiveCell.Offset(, 2).Value = "りんご(その他)" Then 'C列でリンゴかみかんの判断をする With Worksheets("りんご(その他)") 'シートへ記入 .Range("C18").Value = ActiveCell.Offset(0, 0).Value '仕入番号 .Range("C19").Value = ActiveCell.Offset(0, 2).Value '種類 .Range("C20").Value = ActiveCell.Offset(0, 3).Value '産地 .Range("E3").Value = ActiveCell.Offset(0, 4).Value '購入日 .Range("F3").Value = ActiveCell.Offset(0, 5).Value '外観 .Range("G5").Value = ActiveCell.Offset(0, 6).Value '重量 .Range("H5").Value = ActiveCell.Offset(0, 7).Value '単価 .Range("D5").Value = ActiveCell.Offset(0, 9).Value '個数 '繰返し処理をしているので一度に印刷される。 .PrintOut End With ElseIf ActiveCell.Offset(, 2).Value = "りんご(りんご(特定)" Then With Worksheets("りんご(特定)") 'シートへ記入 .Range("C20").Value = ActiveCell.Offset(0, 0).Value '仕入番号 .Range("C21").Value = ActiveCell.Offset(0, 2).Value '種類 .Range("C22").Value = ActiveCell.Offset(0, 3).Value '産地 .Range("E4").Value = ActiveCell.Offset(0, 4).Value '購入日 .Range("F4").Value = ActiveCell.Offset(0, 5).Value '外観 .Range("G7").Value = ActiveCell.Offset(0, 6).Value '重量 .Range("H7").Value = ActiveCell.Offset(0, 7).Value '単価 .Range("D7").Value = ActiveCell.Offset(0, 9).Value '個数 .Range("D8").Value = ActiveCell.Offset(0, 10).Value '送料 '繰返し処理をしているので一度に印刷される。 .PrintOut End With End If End If Loop End Sub

  • エクセルマクロが重い

    こんにちは。 ご教授くださいませ。 すでに先方が作っているエクセルのシートがありまして、 そのシートの表組み規則にのっとって入力するユーザーフォーム を私のほうで作ったのですが、重いです。 selectの多用はだめ!というところまでは調べたのですが じゃあどうしたらいいかわかりません。 ■ '--------------------8時から If OptionButton1.Value = True Then ActiveCell.Offset(3, -1).Range("A1").Select ActiveCell = UserForm3.TextBox1.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox2.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox3.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox4.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox5.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox6.Value ActiveCell.Offset(3, 0).Range("A1").Select ActiveCell = UserForm3.TextBox12.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox11.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox10.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox9.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox8.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox7.Value ActiveCell.Offset(3, 0).Range("A1").Select ActiveCell = UserForm3.TextBox13.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox14.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox15.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox16.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox17.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox18.Value ActiveCell.Offset(3, 0).Range("A1").Select ActiveCell = UserForm3.TextBox24.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox23.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox22.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox21.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox20.Value ActiveCell.Offset(0, -1).Range("A1").Select ActiveCell = UserForm3.TextBox19.Value ActiveCell.Offset(3, 0).Range("A1").Select ActiveCell = UserForm3.TextBox25.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox26.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox27.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox28.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox29.Value ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell = UserForm3.TextBox30.Value 'ActiveWorkbook.Save MsgBox "入力しました。", vbInformation, "確認" End If '--------------------8時から(END ■ 基本の流れは... 最初にオプションボタン3つのどれか1個の 選択を求め、その条件に応じて 始基点となるセルが変わります。 で、あとは与えられた表組みを縦や横に 移動しながら、対応するテキストボックスの 値を入れる、という 我ながら頭の悪い方法で^^; .selectではない、スマートな方法があればと思います。 ぜひお知恵を!

  • VBA Do Until内で値の貼り付けができない

    Excel2003を使用しております。 コピー&値のペースト作業をやってくれるマクロを作成しております。 具体的には、名簿に公がついていれば、その3つ左の名前をD27へ値のみコピペし、 D27がすでに値があれば、D28に書くことを、D37までループするようにしております。 しかし困ったことに、Do Untilコードを使用しておりますが、このコードではなぜか値の貼り付けが出来なくなります。 Sub Ns公() Dim work As Range Set work = Selection If Selection.Value = "公" Then ActiveCell.Offset(0, -3).Select Selection.Copy Do Until Range("D37").Select Range("D27").Select If Selection.Value = "" Then Selection.PasteSpecial paste:=xlPasteValues work.Select Else ActiveCell.Offset(1).Select End If Loop If Range("D36").Value <> "" Then Do Until Range("I37").Select Range("I27").Select If Selection.Value = "" Then Selection.PasteSpecial paste:=xlPasteValues work.Select Else ActiveCell.Offset(1).Select End If Loop work.Select End If work.Select End If work.Select ActiveCell.Offset(1).Select End Sub 原因や対策をご教授いただけるとうれしいです。よろしくお願いします。

  • VBAについて

    いつもお世話になっています マクロ・VBA超初心者です。 質問させてください。 現在シート1の完売のセルの欄に○が入っていれば日付をみてシート2の同じ日付の隣のセルに○を入力しようと思っているのですが、シート2の日付を検索はしているんですが入力がいきません Sheet1  ↓セルA1 ↓セルB1  5月26日   26           B1のセルはDAY(A1)にて出してます         完売  A氏     ○             Sheet2  ↓A列   ↓B列 5月  1日  ・  ・  ・  26日    ○           ←シート1の所に○が付いているとシート1セルB1と同じ  27日                  日付の隣のセルに○を入力  28日 VBA Sub test() Sheets("Sheet2").Select Range("A1").Select Do Until ActiveCell = "" ActiveCell.Offset(1, 0).Activate If ActiveCell.Value = Worksheets("Sheet1").Range("B2") Then ActiveCell.Offset(0, 1).Activate If ActiveCell.Value <> "○" Then ActiveCell.Valu = "○" ActiveCell.Offset(0, -1).Activate Else ActiveCell.Offset(0, -1).Activate End If Else End If Loop Sheets("Sheet2").Select Range("A1").Select End Sub どこが間違っているかわからない状態です。 分かりにくい説明ではあるんですが教えてください お願いします。

  • CheckBoxとTextBoxの値を貼付る方法

    よろしくお願いします。 Dim n As Long Dim r As Range Dim C, buf As String n = Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & n).Select For Each C In Controls If TypeName(C) = "CheckBox" Then If C.Value Then buf = buf & C.Caption & vbCrLf End If Next C ActiveCell.Offset(-1, 16).Value = buf & TextBox9.Value ’buf=チェックされている複数のCheckBoxのCaption ’この時のActiveCell.Offset(-1, 16).ValueにはbufとTextBox9の値も表示されています。 End If で、セルに入力して ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(-1, 16).Value で、セルに貼り付けようとすると、bufの値のみ表示されてTextBox9の値が表示されません。 bufの値とTextBox9の値と両方をコピー表示する方法をお教えください。

  • エクセルの特定のセルの値が変化したらマクロを自動実行させたい。

    エクセルの特定のセルの値が変化したらマクロを自動実行させたい。 エクセルにてシート1のB5に英数字を入力すると シート2のA列を検索し同じ値があるとその行のB列にある値をH6に表示をします。  【例】   シート1のB5に「A5684」と入力   シート2     A   B   1:A5682 パイン    2:A5683 リンゴ   3:A5684 バナナ   シート1のH6に「バナナ」と表示される シート2のA列にない場合はメッセージボックスで「データがありません」と表示します。 またシート3のA1に数字を入れておき、以下のマクロ、  'Sheet3から印刷すべき連番を獲得します。 Worksheets("Sheet3").Select Range("A1").Select 番号 = ActiveCell 連番 = "A" & Application.WorksheetFunction.Rept("0", 5 - Len(番号)) & 番号  'Sheet3の番号セル「B1」を更新します 番号 = 番号 + 1 ActiveCell.FormulaR1C1 = 番号  'Sheet1のセル「H7」欄に連番を表示します。 Worksheets("シート3").Select Range("B1").Select ActiveCell.FormulaR1C1 = 連番 Worksheets("シート1").Select Range("H6").Select '調べたいセルを記入 If IsError(ActiveCell.Value) Then errval = ActiveCell.Value Select Case errval Case CVErr(xlErrDiv0) MsgBox "#DIV/0! エラー" Case CVErr(xlErrNA) If vbOK = MsgBox(" データがありません") Then Exit Sub End Select End If Sheets("シート1").PrintOut Copies:=1 Range("B5").Select Selection.ClearContents '消去 Range("B5").Select End Sub でシート1のH7に(=シート3!B1)として 印刷ごとに1、2、3、と連番を入れています。 フォームで作成したボタンを押すとH6とH7の値が印刷されます。 そしてB5の値がDeleteされ(よってH6は#N/Aとなる) B5にカーソルが行って入力待ち状態になるようにしてあります。 これで、シート1のB5の値が変化又はH6が変化したら 印刷ボタンを押して印刷ではなく自動印刷されるように出来ますか? Private Sub Worksheet_Change(ByVal Target As Range)  If Target.Column = B And Target.Row = 5 Then を使いましたが 「コンパイルエラー」とか Targetの所が色つきになって「End Sub」が必要です。 となってうまく出来ません。 お願いします。

  • エクセルVBAでの関数

    下記、コードでセルに関数を入れるようにしてるのですが 関数で得られた値をセルに反映されるようにしたいのですが Dimを使用してもどう指定してよいのかわからず苦戦しております。 宜しくお願い致します。 Range("F1").Select Do Until ActiveCell.Offset(0, -1).Value = ""       With ActiveCell .FormulaR1C1 = "=MID(RC[-1],2,3)" .Offset(1, 0).Select End With Loop Range("A1").Select Do Until ActiveCell.Offset(0, 2).Value = "" With ActiveCell .FormulaR1C1 = "=RC[11]&RC[5]&Rc[8]&rc[9]&rc[3]" .Offset(1, 0).Select End With Loop

  • エクセルxpのVBA

    VBA初心者です。下記を実行すると、「elseに対応するifがありません」と出ます。なぜかわからず困っています。 For hiniti = DateSerial(Range("A3"), Range("A4"), 21) To DateAdd("m", 1, DateSerial(Range("A3"), Range("a4"), 20)) ActiveCell.Value = hiniti ActiveCell.Offset(0, 1).Select If ActiveCell.Column = 7 Then ActiveCell.Offset(1, -7).Select Else: ActiveCell.Offset(0, 1).Select End If next end sub

  • EXCEL VBA Array要素記述を変更したい

    プログラムの中にセルの値を直接記入しているところがあます。 Select Caseの行の 「Array("101", "102", "103", "104")」のとろです。 プログラムには101, 102, 103, 104ではなくB10~B13を使用したいのですが、うまくできません。 実際には4つだけではなく何十個もあって作業がわずらわしくなるのと、ブックごとに値が異なって 汎用性がないためです。 アドバイスいただけると助かります。 初歩的なことを質問しているかも入れませんが、よろしくお願いいたします。 シート名「表紙」のA列は部品番号(=シート名)でA10:101 A11:102 A12:103 A13:104とします。 これに対応したシートが4つあり、シート名は、「101」「102」「103」「104」とします。 使用者は「表紙」のシートで下記の作業を行います。 B6セルには製造番号(例:AM01-130012)を入力します。 B10~B13セルは「○」「×」を入力規則から選択します ○を選択した隣のC10~C13セルは部品個数で1~9の数値を入力規則から選択します。 ○を選択したのと同じ行のD10~L10、D11~L11、D12~L12、D13~L13セルに、 文字列を入れる場合と入れない場合があります。文字列は左のD列から順に入れます。 下記マクロにて「○」となっているシートのみコピーを作成します。(1) コピーしたシートすべてのB1セルに製造番号を入力します。(2) D列に文字列があれば、コピーした対応するシートの中のH3~P3セルへ貼り付けます。(3) C列の値によって、コピーした対応するシートの中のH3~P3セルの値をクリアします。(4) <表紙のシート>    A     B     C    D     E     F    G    H     I     J     K      L 5 6    AM01-130012 7 8 9  10 101    ×    9 11 102    ○    3 12 103    ○    8  A1-1  A1-2  A1-3  A1-4  A1-5  A1-6  A1-7  A1-8   13 104    ×    9 <プログラム> Sub TestSample() Dim c As Range Dim 製造番号 As String Dim flg As Boolean flg = True With ThisWorkbook 製造番号 = .Worksheets("表紙").Range("B6").Value For Each c In .Worksheets("表紙").Range("B10:B13") If c.Value Like "○*" Then ' ' (1) If flg Then '  初めてなら、○に対応したシートを「新しいブックにコピー」 .Worksheets(c.Offset(, -1).Text).Copy flg = False Else '  それ以外なら、○に対応したシートをアクティブブックの最後にコピー追加 .Worksheets(c.Offset(, -1).Text).Copy After:=Worksheets(Worksheets.Count) End If ' ' (2) ' ' コピーしたすべてのシート(のB2)に製造番号を書き込む Range("B1").Value = 製造番号 ' ' (3) ' ' ○の行のD:L を 対応するシートのH3:P3 へ貼り付け If c.Offset(, 2) <> "" Then '  D列が空でなければ Range("H3").Value = c.Offset(, 2).Value Range("I3").Value = c.Offset(, 3).Value Range("J3").Value = c.Offset(, 4).Value Range("K3").Value = c.Offset(, 5).Value Range("L3").Value = c.Offset(, 6).Value Range("M3").Value = c.Offset(, 7).Value Range("N3").Value = c.Offset(, 8).Value Range("O3").Value = c.Offset(, 9).Value Range("P3").Value = c.Offset(, 10).Value End If End If Next c End With ' ' (4) For Each 各シート In Worksheets With 各シート .Activate Select Case ThisWorkbook.Worksheets("表紙").Cells(Application.Match(各シート.Name, Array("101", "102", "103", "104"), 0) + 9, "C").Value Case "1" '1のときの仕事をする Range("I3:P3").Select Selection.ClearContents Case "2" '2のときの仕事をする Range("J3:P3").Select Selection.ClearContents Case "3" '3のときの仕事をする Range("K3:P3").Select Selection.ClearContents Range("J3").Select Case "4" '4のときの仕事をする Range("L3:P3").Select Selection.ClearContents Case "5" '5のときの仕事をする Range("M3:P3").Select Selection.ClearContents Case "6" '6のときの仕事をする Range("N3:P3").Select Selection.ClearContents Case "7" '7のときの仕事をする Range("O3:P3").Select Selection.ClearContents Case "8" '8のときの仕事をする Range("P3").Select Selection.ClearContents Case "9" 'do nothing Case Else End Select End With Next If flg Then MsgBox "部品番号が選択されていません。" Exit Sub End If

専門家に質問してみよう