• 締切済み

If ~Then文

2つの方法をIf ~Then文により処理したいと思います。 A1~I1のどこかに「価格」文字が入っています。 その「価格」がA1なら(1)パターンを実行、それ以外なら(2)パターンを実行 *(2)パターン実行時は「価格」セルを探してから。(E1) (1)パターン m = ActiveSheet.Range("A3").End(xlDown).Row Range("A1:E" & m).Select Range("B1:E" & m).Select Selection.ClearContents Range("F1").Select (2)パターン n = ActiveSheet.Range("A3").End(xlDown).Row Range("E1:I" & n).Select Selection.Cut Range("A1").Select ActiveSheet.Paste Range("F1").Select お願い致します。

みんなの回答

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.6

こんにちは。 ざっと読んでみたところ、そのコードではきちんとロジックが通っていないようですね。 >A1~I1のどこかに「価格」文字が入っています。 >Range("A1:E" & m).Select >Range("B1:E" & m).Select A列で見つかって、なぜ、E列まででしょうか? B列、C列、E列、~ I列としていく、どこかでロジックがヘンではありませんか? そして、なぜ、F1を選択するのでしょうか? ------------------------------------------- Range("E1:I" & n).Select Selection.Cut Range("A1").Select ActiveSheet.Paste Range("F1").Select こちらも同様にヘンですね。消したE列からI列を選択して、それをA列に貼り付けしようとしています。 >A1~I1のどこかに「価格」文字が入っています。 つまり、ここの最初の設問の部分が、上手く成り立っていないようです。 マクロのコードではなく、どういう内容になっているか、そして、どうしたいのか説明していただいたほうが良いのではないか、と思います。

maki6006
質問者

補足

回答有難う御座います。 元々(1)パターンと(2)パターンは別Bookで実行しておりました。 「価格」はA1の場合限定と可変によりD1やE1となる場合があります。 (1)パターンは「価格」A1の限定 (2)パターンは「価格」可変によりD1やE1(例ではE1に限定) Range("F1").Selectはマクロ記録により 不要でしたね。 説明不足ですみません。

  • ASIMOV
  • ベストアンサー率41% (982/2351)
回答No.5

>*(2)パターン実行時は「価格」セルを探してから。(E1) すいません、意味が解りません セルの位置は cells(1,i) ですが、 (E1)<- は何か意味が有るのでしょうか?

maki6006
質問者

補足

For i = 1 To 9  If Cells(1, i) = "価格" Then   If i = 1 Then m = ActiveSheet.Range("A3").End(xlDown).Row Range("A1:E" & m).Select Range("B1:E" & m).Select Selection.ClearContents Range("F1").Select   Else n = ActiveSheet.Range("A3").End(xlDown).Row Range("E1:I" & n).Select Selection.Cut Range("A1").Select ActiveSheet.Paste Range("F1").Select   End If  End If Next 例ではRange("E1:I" & n).Select  E1と限定してしまっております。 E1 → cells(1,i)にするには という事なんですが 解りにくく申し訳御座いません。

  • Yorisin
  • ベストアンサー率54% (364/663)
回答No.4

また間違えた。 acticevell.offset(1,0) を activecell.offest(1,0).select にして下さい。

  • Yorisin
  • ベストアンサー率54% (364/663)
回答No.3

ごめんなさい。offsetの後にselectを入れ忘れました。 下記でOKと思います。 if range("A1").value="価格" then パターン(1) else i=0 do activecell.offest(1,0) i=i+1 loop while(activecell.value<>"価格" or i<9) if activecell.value="価格" then パターン(2) end if end if

maki6006
質問者

お礼

再度有難う御座います。 if range("A1").value="価格" then パターン(1) else i=0 do activecell.offest(1,0).Select i=i+1 loop while(activecell.value<>"価格" or i<9) if activecell.value="価格" then パターン(2) end if end if >activecell.offest(1,0).Select デバッグになってしまいました。

  • ASIMOV
  • ベストアンサー率41% (982/2351)
回答No.2

For i = 1 To 9  If Cells(1, i) = "価格" Then   If i = 1 Then    MsgBox "(1)パターン"   Else    MsgBox "(2)パターン"   End If  End If Next ------------------------- で、どうでしょう

maki6006
質問者

補足

回答有難う御座います。 *(2)パターン実行時は「価格」セルを探してから。(E1) はどのようにしたらよいでしょうか。

  • Yorisin
  • ベストアンサー率54% (364/663)
回答No.1

勝手にExcelと判断します。 きれいなルーチンじゃないけど、これでどうでしょうか? if range("A1").value="価格" then パターン(1) else i=0 do activecell.offest(1,0) i=i+1 loop while(activecell.value<>"価格" or i<9) if activecell.value="価格" then パターン(2) end if end if

maki6006
質問者

お礼

回答有難う御座います。 >activecell.offest(1,0) コンパイルエラーになってしまいました。

関連するQ&A

  • マクロでシート2~6のデータをシート1に転記したい

    マクロでシート2~6のデータをシート1に転記したいです。 シート2~6のデータを シート1に順番に転記したくてマクロの記録を利用して作成しました。 シート2~6は列は同じですが行数は異なります。 また行数は作業の都度異なります。 同じ記述が繰り返されているので もう少し記述が短くできるのではと思うのですが どうすればいいでしょうか? Sub データ更新() 'シート1の前回データをクリア Sheets("シート1").Select Range("A2:Q2").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("A2").Select Sheets("シート1").Select Range("A1").Select Sheets("シート2").Select Range("A1").Select 'ヘッダーも合わせて取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート3").Select Range("A2").Select 'データのみ取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート4").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート5").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート6").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select End Sub

  • エクセルVBAの保存

    毎月異なった新しいエクセルファイルに同じような加工を施すため、VBAを書きました。対象はActivesheetとしています。 で、質問は、この新しいエクセルファイルの標準モジュールにいちいちこのVBAをコピーペーストせずに実行する方法です。 きっと何かあるとは思うのですが・・・・。 VBAは次のような簡単なものです。 Sub 加工1() Dim e As Integer, s As String, n As String e = Range("A4").End(xlDown).Row s = Replace(Mid(Range("A2"), 8, 5), "年", "") & "-" n = Replace(Mid(Range("A2"), 19, 5), "年", "") & "-" Range("A1:C2").MergeCells = False Columns("B:B").Select Selection.Insert Shift:=xlToRight Columns("A:A").Select Selection.Insert Shift:=xlToRight Columns("C:C").Select Selection.NumberFormatLocal = "G/標準" Range("B3").Select Selection.AutoFill Destination:=Range("B3:C3"), Type:=xlFillDefault Range("B3").Select ActiveCell.FormulaR1C1 = "商品番号1" Range("C4").Select ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],10)" Range("C4").Select Selection.AutoFill Destination:=Range("C4:C" & e), Type:=xlFillDefault Range("A3").Select ActiveCell.FormulaR1C1 = "抽出年月日" Range("A4").Select ActiveCell.FormulaR1C1 = s & n & 1 Range("A4").Select Selection.AutoFill Destination:=Range("A4:A" & e), Type:=xlFillDefault Rows("3:3").Select Selection.Insert Shift:=xlDown Range("B1:E1").MergeCells = True Range("B2:E2").MergeCells = True ActiveSheet.Name = "提出用" End Sub

  • マクロ登録したピボットが重いのです

    以前、http://oshiete1.goo.ne.jp/qa3362330.html を質問させていただいた者です。 同じくエクセル2003で、ピボットを作りました。VBAで、 Selection.End(xlDown).Select N = Selection.Row を登録し、下記のプログラムを作ったところ、★の部分で再計算が始まり、終了まで非常に時間がかかってしまいます(1分程)。マクロは作動しますので、時間がかからないようにする方法はあるでしょうか。よろしくお願いします。 Sheets("data").Select Range("D1").Select ActiveCell.FormulaR1C1 = "担当" Selection.End(xlDown).Select N = Selection.Row ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],number!C[-3]:C[-2],2,0)" Selection.AutoFill Destination:=Range("D2:D" & N) Range("D2:D" & N).Select Selection.Copy ★ Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Sheets("answer").Select Range("A1").Select ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _ "data!R1C1:R" & N & "C4").CreatePivotTable TableDestination:="[集計(1).xls]answer!R1C1", _ TableName:="ピボットテーブル1", DefaultVersion:=xlPivotTableVersion10 With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("性別") .Orientation = xlRowField .Position = 1 End With With ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("商品番号") .Orientation = xlColumnField .Position = 1 End With ActiveSheet.PivotTables("ピボットテーブル1").AddDataField ActiveSheet.PivotTables( _ "ピボットテーブル1").PivotFields("価格"), "合計 / 価格", xlSum Columns("A:A").ColumnWidth = 30 Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select End Sub

  • エクセルVBAで教えて下さい。

    A1のセルに [ 1- 5] 4.05398e-01 3.63385e-01 -2.22992e-01 9.89158e-03 -6.43695e-02 A2のセルに [ 6-10] -5.12224e-04 4.07480e-04 -2.73746e-04 -1.77853e-02 -2.13805e-03 A3のセルに [11-15] -6.88489e-03 -2.06765e-02 -9.44633e-03 6.97059e-03 -1.28400e-02 と、このような感じでA7セルまで同じ感じでスペースで空いた数値が入力されています。 A8のセルのみ [36-37] -6.39210e-03 -1.55806e-03 と入力されております。 まず行いたいのはスペースが空いてる部分で、それぞれの数値を各セルに分けたいです。 A1のセルに入力されている [ 1- 5] 4.05398e-01 3.63385e-01 -2.22992e-01 9.89158e-03 -6.43695e-02 ならば A1に[1-5] B1セルに4.05398e-01 C1セルに3.63385e-01 のように これをA1からA8のセルで行ったあと指定のセルを30行目に貼り付けます。 E1→A29 C2→B29 D2→C29 E2→D29 E3→E29 F3→F29 B4→G29 D5→H29 E5→I29 F5→J29 貼り付けのデータは増えていきます。つまり、30行目にデータが入ってる場合は そのデータが1行下の行に下がり、新たなデータが30行目に追加されます。 このようにして、データが最大で58行目まで追加される可能性があります。 最小であれば30行目、31行目の2つしかない場合あります。 この時、0の近似値を各列のセルから探し、当てはまるセルを赤く塗り潰すというのが 今回行いたいことです。 A列ならA30~A58までの中で0の近似値を探し、当てはまるセルを赤く塗り潰す。 ただ空白の場合は無視してもらいたいです。0の近似値だと空白が選択されてしまうので。 近似値探しの前までならマクロがありますのでご参照下さい。 Sub Macro4() ' ' Macro4 Macro ' ' Range("A1:A8").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(21, 1), Array(34, 1), Array(47, 1), _ Array(60, 1)), TrailingMinusNumbers:=True Range("A1").Select Range("E1").Select Selection.Copy Range("A29").Select ActiveSheet.Paste Range("C2:E2").Select Application.CutCopyMode = False Selection.Copy Range("B29").Select ActiveSheet.Paste Range("E3:F3").Select Application.CutCopyMode = False Selection.Copy Range("E29").Select ActiveSheet.Paste Range("B4").Select Application.CutCopyMode = False Selection.Copy Range("G29").Select ActiveSheet.Paste Range("D5:F5").Select Application.CutCopyMode = False Selection.Copy Range("H29").Select ActiveSheet.Paste Range("J7").Select Application.CutCopyMode = False Range("A29:K29").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A29:K29").Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("A29").Select Range("A1:F8").Select Selection.ClearContents Range("A1").Select Range("K29").Select With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormatLocal = "G/標準" End Sub わかりずらい質問ですみませんが、ご指導の程 お願い致します。

  • 実行時エラー”1004” 初心者です

    Excel_2000のVBAです。 sheet1のコマンドボタンを押すと"明細”というシートのデータが入っている範囲を選択するようにしたいのですが、ActiveSheet.Range(Cells(4, 3), Cell(OwariGyo, 8)).Selectのところで実行時エラー"1004"が出ます。 ヘルプを見ても、よく理解できませんでした。 解決方法をご教示ください。 Worksheets("明細").Select ActiveSheet.Range("C4").Select Selection.End(xlDown).Activate OwariGyo = ActiveCell.Row ActiveSheet.Range(Cells(4, 3), Cell(OwariGyo, 8)).Select End Sub

  • マクロ 可視セルへコピーする方法

    こんにちは。よろしくお願いします。 A~V列、300~400行程度の表を作っています。 8行目をコピーして空白行へペーストしたいのですがどのようにすれば良いでしょうか。 マクロの記録でつくったものは ActiveSheet.Paste でエラーになります。 またペースト開始行をA17ではなくて可変なものに変えたいです。 よろしくお願いします。 Sub 下までコピー() Range("A8:V8").Select Selection.Copy Selection.AutoFilter Field:=2, Criteria1:="=" Range("A17:V" & Range("B5").End(xlDown).Row).Select Selection.SpecialCells(xlCellTypeVisible).Select ActiveSheet.Paste Application.CutCopyMode = False Selection.AutoFilter Field:=2 End Sub

  • マクロでのActiveSheet.Pasteでのデバック

    関数の入ったセルを切取りで貼付けたいのですが、ActiveSheet.Pasteのところで"WorksheetクラスのPasteメソッドが失敗しました.”のデバッグになってしまいます。対応を教えていただけないでしょうかお願い致します。 Sub susiki() Columns("A:J").Select Selection.AutoFilter Selection.AutoFilter Field:=6, Criteria1:="AG" Dim kirix As Integer, kiriy As Integer Dim kiriz As Long kiriy = Range("A:A").Column kiriz = Range("F1").End(xlDown).Row For kirix = 1 To kiriy Range(Cells(kiriz, kirix), Cells(kiriz, kirix)).Select Selection.CurrentRegion.Select Selection.Cut Next kirix Selection.AutoFilter Field:=6, Criteria1:="DB" Dim harix As Integer, hariy As Integer Dim hariz As Long hariy = Range("A:A").Column hariz = Range("F1").End(xlDown).Row For harix = 1 To kiriy Range(Cells(hariz, harix), Cells(hariz, harix)).Select ActiveSheet.Paste Next harix Selection.AutoFilter End Sub

  • 別ブックからのデータ取り込み

    下記の(1)(2)のマクロを(3)のコマンドボタンで実行させています。 (1)(2)を使用せずに(3)のコマンドボタンにまとめて記載したいのですが上手く出来ません。 また、(1)の"A:\あ.CSV"部分ですが、使用PCによってドライブが異なる場合があるります。セルC2に入力したドライブ名を反映させることはできないでしょうか? よろしくお願いします。 (1) Sub I()    Workbooks.Open Filename:="A:\あ.xls"    lngR = Range("B65536").End(xlUp).Row    Range("B2:B" & lngR).Select    Selection.Copy    Windows("か.xls").Activate    Range("B3").Select    ActiveSheet.Paste    lngR = Range("B65536").End(xlUp).Row    Range("B2:F" & lngR).Select    With Selection.Font     .Size = 8    End With     End Sub (2) Sub II()    Windows("あ.xls").Activate    lngR = Range("E65536").End(xlUp).Row    Range("E2:E" & lngR).Select    Selection.Copy    Windows("か.xls").Activate    Range("G3").Select    ActiveSheet.Paste    lngR = Range("G65536").End(xlUp).Row    Range("G2:G" & lngR).Select    Selection.Style = "Comma [0]"    With Selection.Font     .Size = 9    End With    Windows("あ.xls").Activate    ActiveWindow.Close   End Sub (3) Private Sub 取込_Click()    Application.ScreenUpdating = False    Protect UserInterfaceOnly:=True    Application.Run "I"    Application.Run "II"    Selection.Locked = False    Applicaion.ScreenUpdating = True   End Sub

  • ExcelのVBAです。

    先日お答えいただいたVBAなんですが、 Sub Macro1() Sheets("Sheet1").Select Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("Sheet3").Select Range("A1").Select ActiveSheet.Paste Selection.End(xlDown).Select Application.CutCopyMode = False Do Selection.Insert Shift:=xlDown Selection.End(xlUp).Select Loop Until ActiveCell.Address = "$A$1" End Sub というのを使用させて頂いてます。 これを、コピー先のものを上書きせずに、コピーされたものがあれば表示させるといった風に出来ないでしょうか? 例  A    A 1 a 1 2 b → 2あ 3 c 3 右から左に一行間隔で別シートに表示させたいのですが、  A  1 a 2 あ 3 b 4 5 b という結果にしたいのです。 拙い文章で申し訳ないのですが、教えて頂きたいです。

  • 色々なものを見ながら作っている初心者です。

    色々なものを見ながら作っている初心者です。 よろしくお願いします。 VBAでのエラー対処について 下記のマクロを実行すると、実行時 「Selection.Resize(, Selection.Columns.Count - 2).Select」のところで セルがブランクだった時にエラーが出てします。 対処の方法を教えていただけませんでしょうか? よろしくお願いします。 Sheets("sheetB1").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("D12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB1").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("E12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("B1").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetB2").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("J12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB2").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("K12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("steetB2").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=Fals

専門家に質問してみよう