今だけ人気マンガ100円レンタル特集♪

マクロ初心者です。

次のリストからマクロを実行した際にリスト名のシートを作成する方法を教えていただけないでしょうか。
   A  B  C … 
1 県名
2 北海道
3 青森
4 秋田
5 岩手
6 山潟
7 新潟
8 宮城
9 (空白)
10(空白)

1~10までのリストを以下のマクロで実行すると9と10が空白の為、「実行時エラー’1004’:アプリケーション定義またはオブジェクト定義のエラーです。」が実行後に表示されます。空白があってもエラーが出ないようなマクロを作成するにはどのようにしたらよいでしょうか?
また、実行後にリスト名が誤っていて再度マクロを実行した際に誤っているところだけ別にシートが作成されて誤っていないところはそのままというようなマクロは作成できるものでしょうか?
(例)A-6 山潟 → 山形に訂正し、再度マクロを実行した際に山形というシートだけが追加作成される。

Sub リストから連続シート作成()
Dim 県名 As Range
For Each 県名 In Worksheets("リスト").Range("A2:A10")
Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = 県名.Value
ActiveSheet.Range("A1") = 県名.Value
Next 名前
End Sub

無理なことを言っているかもしれませんが詳しい方、どうかよろしくお願いいたします。

A 回答 (4件)

こんばんは!



>空白があってもエラーが出ないような・・・
に関して

A2~A10セルと決まっているのですかね?
そうであれば
>For Each 県名 In Worksheets("リスト").Range("A2:A10")
の次に
>If 県名 <> "" Then


>Next 名前  ← Next 県名 では?
の前に
>End If
をそれぞれ追加してみてください。

次にシート名の変更についてですが、
Excel的には「山潟」は「山形」の間違いだという判別はできません。
どこかに正誤表があって、それを参照するのであれば可能です。

まずはこの程度で。m(_ _)m
    • good
    • 0
この回答へのお礼

早々に回答いただき、お礼が遅くなり大変申し訳ありませんでした。自分でも教えらてとおりやってみたらエラーが出なくなり、大変助かりました。

お礼日時:2020/05/31 15:04

空白を判定するより、エラートラップしちゃった方が、良いような気がします。


シート名に使えない文字(例えば、"/")もあるので、すべて判断していると、気が狂いそうです(ちょっと大げさ)
こんな感じでです。

Sub リストから連続シート作成()
Dim 県名 As Range
For Each 県名 In Worksheets("リスト").Range("A2:A10")
Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
On Error Resume Next
ActiveSheet.Name = 県名.Value
If Err.Number = 1004 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Else
ActiveSheet.Range("A1") = 県名.Value
End If
On Error GoTo 0
Next 県名
End Sub
    • good
    • 0
この回答へのお礼

このたびはご返事いただき大変有難うございました。
考え方でVBAの組み方もいろいろあるんだなと思って感心するばかりです。
これから僕も少しずつ勉強していきたいと思っています。
ご教授いただき、有難うございました。

お礼日時:2020/05/31 14:58

こんばんは、


空白データの処理は、すでに回答されている通りIf文で条件分離すれば良いと思います。
しかし、
>実行後にリスト名が誤っていて再度マクロを実行した際に誤っているところだけ別にシートが作成されて誤っていないところはそのままというようなマクロは作成できるものでしょうか?

マクロは、プログラムなので、論理的説明が出来れば、作成は可能と思います。手法は別として。
ご質問の場合、何が誤りか?判断できない所が問題になります。。ですので、ご質問の流れを考え、誤っていると言うのは、
既存シート名と新規シート名(リスト)の差異を指しているものと推察します。
であれば、リストの内容と既存のシート名を照合して、シート名にあるものは、実行せず、シート名に無くリストにあるものを
シート名としてシート作成を行えば良い事になります。

疑問としては、いわゆる間違いと称するシートをどう扱えば良いかと言う事、削除してしまっても良いのでしょうか。
間違えにおそらく入力されているデータはどうするのか?まあ、それこそどこに移せば良いか判断が出来ないかと思いますが、、

なされたい事は、作成のみのようですね。
的外れかもしれませんが、サンプルを示します。ぱっと見、難しい内容になってしまったので、
もっと簡単に考えた方が良いのかも知れません。。取り敢えず、削除部分は、コメントアウトしてあります。

試す場合は、小さなブックで検証してください。
標準モジュールに、実行プロシージャは、 リストから連続シート作成()です。

Option Explicit
Sub リストから連続シート作成()
Dim myList(), mySht()
Dim Old_name As Variant, New_name As Variant
Dim i As Long, j As Long, LastRow As Long
  With Worksheets("Sheet1")
  '質問に合わせて10行目まで(コメント部は最終行
    LastRow = 10     '.Cells(Rows.Count, 1).End(xlUp).Row
    ReDim mySht(1 To Worksheets.Count)
    ReDim myList(1 To LastRow - 1)
    For i = 2 To LastRow
      If .Cells(i, 1) <> "" Then
        myList(i - 1) = .Cells(i, 1)
      End If
    Next
  End With
  For i = 1 To Worksheets.Count
    If Sheets(i).Name <> "原本" Then
      j = j + 1
      mySht(j) = Sheets(i).Name
    End If
  Next
  '  On Error Resume Next
  Old_name = AryCHK(myList, mySht)  '削除の為のチェック
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  ' リストに無いシートを削除
  '  If IsArrayEx(Old_name) = 1 Then
  '    If Worksheets.Count > UBound(Old_name) Then
  '      Sheets(Old_name).Delete
  '    End If
  '  End If
  Application.DisplayAlerts = True
  New_name = AryCHK(mySht, myList)  '作成の為のチェック
  If IsArrayEx(New_name) = 1 Then
    For i = LBound(New_name) To UBound(New_name)  'シート名にないシートをリストから作成
      Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
      ActiveSheet.Name = New_name(i)
      ActiveSheet.Range("A1") = New_name(i)
    Next
  End If
  Application.ScreenUpdating = True
End Sub

'配列に存在するかチェック(戻り値は存在しない値)
Function AryCHK(Ary, CHK) As Variant()
Dim i As Long, n As Long: n = 0
Dim varResult As Variant, return_Array()
  For i = 1 To UBound(CHK)
    varResult = Filter(Ary, CHK(i))
    If UBound(varResult) <> -1 Then
    Else
'Debug.Print CHK(i)
      If CHK(i) <> "" Then
        ReDim Preserve return_Array(n)
        return_Array(n) = CHK(i)
        n = n + 1
      End If
    End If
  Next
  AryCHK = return_Array
End Function
Function IsArrayEx(varArray As Variant) As Long
  On Error GoTo ERROR_
  If IsArray(varArray) Then
    IsArrayEx = IIf(UBound(varArray) >= 0, 1, 0)
  Else           '1:配列;0:空の配列;-1:Not配列
    IsArrayEx = -1
  End If
  Exit Function
ERROR_:
  If Err.Number = 9 Then
    IsArrayEx = 0
  End If
End Function
    • good
    • 0
この回答へのお礼

このたびはご返事いただき大変有難うございました。
今回の質問でこんなに考えていただき有難うございました。
今回教えていただいたVBAの内容は初心者の僕にとってまだ理解できない
ですがこれから少しずつ勉強して皆様のように組めればいいなと思ってます。
大変有難うございました。

お礼日時:2020/05/31 15:00

こんばんは



>9と10が空白の為、「実行時エラー~~~」が実行後に表示されます
そこまで分析ができているのですから、「セルの値が空白だったら処理をスキップする」(=空白ではないときだけ実行する)ようになさってはいかがでしょうか。
    • good
    • 0
この回答へのお礼

このたびはご回答いただき有難うございます。
インターネットで自己解決しようと思いましたが初心者の自分にとってはなかなか難しく皆様の回答で解決することができ大変助かりました。

お礼日時:2020/05/31 15:03

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング