• 締切済み

エクセル2010でマクロが動きません

こんにちは。 マクロ超初心者です。 頑張ってエクセル2016でマクロ作成しましたが、エクセル2010で途中から動かず…。 何が悪いんでしょうか… ここから動きません…と書いたところから動きません(涙) Private Sub シート編集_Click() Application.ScreenUpdating = False Dim i Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim Sh4 As Worksheet Set Sh1 = Worksheets("あ") Set Sh2 = Worksheets("い") Set Sh4 = Worksheets("う") Dim dayCutoff As Date dayCutoff = Application.InputBox("年月日を入力してください", "お支払期限 年月日を入力", Format(Date, "yyyy/mm/dd")) Sh4.Range("D12").Value = DateSerial(Year(dayCutoff), Month(dayCutoff) + 2, 0) 'お支払期限 dayCutoff = Application.InputBox("年月日を入力してください", "請求書発行 日を入力", Format(Date, "yyyy/mm/dd")) Sh4.Range("AC3").Value = Format(Date, "yyyy/mm/dd") '発行日 Sh1.Cells.Clear With Sh1 'edit .Range("A2") = "番号" .Range("B2") = "会社名" .Range("C2") = "判定" .Range("D2") = "契約番号" .Range("E2") = "拠点" .Range("F2") = "税率" .Range("G2") = "月額(税抜)" .Range("H2") = "消費税" .Range("I2") = "月額(税込)" .Range("J2") = "今回" .Range("K2") = "全回" .Range("L2") = "店番" ここから動きません………… For i = 3 To Sh2.Cells(.Rows.Count, 1).End(xlUp).Row .Cells(i, 1) = Sh2.Cells(i, 2) .Cells(i, 2) = Sh2.Cells(i, 4) .Cells(i, 4) = Sh2.Cells(i, 3) .Cells(i, 5) = Sh2.Cells(i, 4) & "(" & Sh2.Cells(i, 6) & ")" .Cells(i, 6) = Sh2.Cells(i, 9) & "%課税" .Cells(i, 7) = Sh2.Cells(i, 8) .Cells(i, 8) = Sh2.Cells(i, 10) .Cells(i, 9) = Sh2.Cells(i, 11) .Cells(i, 10) = Sh2.Cells(i, 12) .Cells(i, 11) = Sh2.Cells(i, 7) .Cells(i, 12) = Sh2.Cells(i, 2) If Sh1.Cells(i, 10) > Sh1.Cells(i, 11) Then .Cells(i, 3) = "×" Else .Cells(i, 3) = "〇" End If If Sh1.Cells(i, 3) = "×" Then .Cells(i, 2) = "" End If Next i End With '空白行を削除 Dim j As Integer, myFlag As Boolean Dim c As Range With Worksheets("edit").Range("A2").CurrentRegion For j = .Rows.Count To 2 Step -1 myFlag = False For Each c In .Cells(j, 2) If c.Value <> "" Then myFlag = True Exit For End If Next If myFlag = False Then .Rows(j).Delete End If Next End With MsgBox "データの転記が終わりました" End Sub

みんなの回答

  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.5

>i=3となったのですが デバッグの方法はそれであっていると思います。 ただ、今回のポイントはそこではなく、 >Sh2.Cells(.Rows.Count, 1).End(xlUp).Row この値が正しく表の最終行となっているか、 >Sh2.Cells(i, 2) この値で正しく表の値をとれているかです。 ステップ実行でどこに誤りがあるのかを確認することで 修正ポイントがわかると思います。

  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.4

For i = 3 To Sh2.Cells(Sh2.Rows.Count, 1).End(xlUp).Row ここにブレークポイントを設定して、 .Rows.Countが想定した値が入っているか 次の行へ移動して Sh2.Cells(i, 2)に値が入っているか ステップ実行でデバッグすることをお勧めします。

belltheelmo0615
質問者

お礼

アドバイスありがとうございます! 2016のほうも2010のほうもi=3となったのですが…ブレークポイントが初めてでネットで調べながらやってみたのですが、合っていますでしょうか…?

  • masnoske
  • ベストアンサー率35% (67/190)
回答No.3

With Sh1 'edit (中略) For i = 3 To Sh2.Cells(.Rows.Count, 1).End(xlUp).Row (中略) End With Sh2.Cells(.Rows.Count, 1) の .Rows.Countの取り扱いが Excel2016と2010で違うのかも知れませんね。私の環境に 2016がないので確認できませんが… Rows.Countはワークシートの全行数です。その前に . がありますから、Sh2.Cells(.Rows.Count, 1)は、 Sh2.Cells(Sh1.Rows.Count, 1) です。 Sh2の1列目全部を指定するのに Sh1の全行数を使用するのは、個人的には違和感があります。 Excel2016は、その違和感を許すが 2010は許さないということでしょうか。

belltheelmo0615
質問者

お礼

ありがとうございます。 とりあえず毎回行数がかわるシートの内容を別シートに貼り付けられればありがたいんですが… なんでできないのか、謎です

belltheelmo0615
質問者

補足

ありがとうございます! 試してみたのですが、変わらずでした… 最後にメッセージは表示されるので、シートの内容のコピーができないみたいです。

  • o_chi_chi
  • ベストアンサー率45% (131/287)
回答No.2

Sh2.Cells(.Rows.Count, 1).End(xlUp).Row Sh2.Rows.Count では?

belltheelmo0615
質問者

お礼

ありがとうございます! 内容を単にコピペだけのマクロにしてみたんですが、それでもデータが空欄のままでした。 何が原因なんでしょう…

belltheelmo0615
質問者

補足

ありがとうございます! 試してみたのですが、こちらも変わらずでした… 最後にメッセージは表示されるので、シートの内容のコピーができないみたいです。

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

エラーなく動きましたよ Private Sub CommandButton1_Click()   Application.ScreenUpdating = False   Dim i   Dim Sh1 As Worksheet   Dim Sh2 As Worksheet   Dim Sh4 As Worksheet   Set Sh1 = Worksheets("あ")   Set Sh2 = Worksheets("い")   Set Sh4 = Worksheets("う")   Dim dayCutoff As Date   dayCutoff = Application.InputBox("年月日を入力してください", _       "お支払期限 年月日を入力", Format(Date, "yyyy/mm/dd"))   Sh4.Range("D12").Value = DateSerial(Year(dayCutoff), _       Month(dayCutoff) + 2, 0) 'お支払期限   dayCutoff = Application.InputBox("年月日を入力してください", _       "請求書発行日を入力", Format(Date, "yyyy/mm/dd"))   Sh4.Range("AC3").Value = Format(Date, "yyyy/mm/dd") '発行日   Sh1.Cells.Clear   With Sh1 'edit     .Range("A2").Resize(, 12).Value = Array("番号", "会社", "判定", _           "契約番号", "拠点", "税率", "月額(税抜)", "消費税", _           "月額(税込)", "今回", "全回", "店番") 'ここから動きません…………     For i = 3 To Sh2.Cells(Sh2.Rows.Count, 1).End(xlUp).Row       .Cells(i, 1) = Sh2.Cells(i, 2)       .Cells(i, 2) = Sh2.Cells(i, 4)       .Cells(i, 4) = Sh2.Cells(i, 3)       .Cells(i, 5) = Sh2.Cells(i, 4) & "(" & Sh2.Cells(i, 6) & ")"       .Cells(i, 6) = Sh2.Cells(i, 9) & "%課税"       .Cells(i, 7) = Sh2.Cells(i, 8)       .Cells(i, 8) = Sh2.Cells(i, 10)       .Cells(i, 9) = Sh2.Cells(i, 11)       .Cells(i, 10) = Sh2.Cells(i, 12)       .Cells(i, 11) = Sh2.Cells(i, 7)       .Cells(i, 12) = Sh2.Cells(i, 2)       If Sh1.Cells(i, 10) > Sh1.Cells(i, 11) Then         .Cells(i, 3) = "×"       Else         .Cells(i, 3) = "〇"       End If       If Sh1.Cells(i, 3) = "×" Then         .Cells(i, 2) = ""       End If     Next i   End With '空白行を削除   Dim j As Integer, myFlag As Boolean   Dim c As Range   With Worksheets("edit").Range("A2").CurrentRegion     For j = .Rows.Count To 2 Step -1       myFlag = False       For Each c In .Cells(j, 2)         If c.Value <> "" Then           myFlag = True           Exit For         End If       Next       If myFlag = False Then         .Rows(j).Delete       End If     Next   End With   MsgBox "データの転記が終わりました" End Sub