こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

エクセル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

投稿日時 - 2018-09-25 18:41:19

QNo.9541040

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.5

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

投稿日時 - 2018-10-10 17:50:15

ANo.4

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

投稿日時 - 2018-10-10 14:19:19

お礼

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

投稿日時 - 2018-10-10 15:40:19

ANo.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は許さないということでしょうか。

投稿日時 - 2018-10-03 06:37:15

補足

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

投稿日時 - 2018-10-10 07:44:07

お礼

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

投稿日時 - 2018-10-10 07:47:08

ANo.2

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

投稿日時 - 2018-10-01 16:11:16

補足

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

投稿日時 - 2018-10-10 07:47:58

お礼

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

投稿日時 - 2018-10-10 07:50:02

ANo.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

投稿日時 - 2018-09-25 20:50:39

あなたにオススメの質問