親子におすすめの新型プラネタリウムとは?

いつもお世話になってます。
現在、表を比較するマクロを作成しています。
内容は下記のものです。
ーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub ⑬チェック2()

Dim tableA As Range
Dim tableB As Range
Dim j As Long
Dim MyRng As Range

Set MyRng = Application.InputBox(prompt:="範囲指定し下さい", Default:=Range("A1:A2").Address(0, 0), Type:=8)

For j = 2 To Worksheets.Count

Worksheets(j).Select
Set tableA = MyRng
Set TableB = Range("A48:AI54")


Dim i As Integer


For i = 1 To tableA.Cells.Count
If tableA.Cells(i).Value <> tableB.Cells(i).Value Then
tableB.Cells(i).Interior.ColorIndex = 6
End If
Next i
Next j
End Sub

ーーーーーーーーーーーーーーーーーーーーーーーーーーー
問題は範囲の指定です。
表の内、片方は固定した位置にあるのですが
もう片方はブックによって違ってきます。
ですので、範囲指定をInputBoxで行おうと思い、上記のような形になりました。

当初は
Worksheets(j).Select
Set MyRng = ~
Set tableA = ~
という形でやってみましたが、するとシートを移るごとに
範囲指定させられるので今のような形になりました。
今の状態ですと最初に指定した一枚目のシートのtableAと
それぞれの表のtableBを比較してしまいます。

想定している動きとしては
最初に範囲を指定したら、それぞれのシートのtableAとtableBの比較を行いたいです。

InputBoxのコードをいまいちよくわからず書いているところがあるので
そちらの問題かと考えていますが、ご指摘いただけますでしょうか。

よろしくお願いいたします。

A 回答 (1件)

こんにちは



>Worksheets(j).Select
>Set tableA = MyRng
で、selectしたシートの同じ範囲を設定なさっているおつもりと思いますが、Rangeオブジェクトはセル範囲だけでなくシートの情報も持っています。
それなので、上記でtableAにセットされるセル範囲は、MyRngを入力した時のシートになっていて、Worksheets(j)と一致するとは限りません。

試しに、
 MsgBox tableA.Worksheet.Name
などとするか、ウォッチ式で調べてみるとわかると思います。
複数のシートにまたがる処理をする場合は、必ずシートも明記するようにした方が間違えは少なくなると思います。

例えば、
 Set tableA = Worksheets(j).Range(MyRng.Address())
などとするとか…


話は、ご質問からそれてしまいますが・・・

ユーザに自由に入力させると、範囲は想定したものと違う入力をされる可能性があります。(数が違うとか、形が違って3×3とか)
それなので、固定範囲(ご提示のコードではA48:AI54の7セル)と比較する際に、tableAの範囲でループさせると、tableAの方が大きな場合はエラーが発生してします。
入力された範囲をきちんとチェックするか、あるいは、必ず形(範囲)が同じになるようにするためには、ユーザには左上のセルだけを指定してもらう、などといったほうが良さそうにも思います。

一方で、なんとなく全体を読んだ推測ではありますが、
『ブック毎に異なるけれどブック内では固定の範囲で、値が等しいかのチェックを行いたい』
ということのように推測します。

現状で、すでに複数ブックがあると思いますので、今更になってしまうかもしれませんが、ブック毎に条件付き書式を設定しておけば、誤入力の可能性のあるような操作をさせることもなく、チェックが可能だと思います。
それぞれは何らかの定型シートだと推測しますので、ブックごとにひな形を作成しておけば、シートを追加する際はそれを利用することで、条件付き書式もそのまま生かすことが可能です。

この方法の一番良いところは、
『わざわざマクロを実行させてチェックなどをしなくても、常に自動的にチェックが働いた状態にできる』
というところでしょうか。
    • good
    • 0
この回答へのお礼

ご回答、まことにありがとうございます。
ご指導していただいた通りにSet tableA=~を修正しましたところ思ったとおりの動きになりました。
基本的な知識が身についていないと痛感しております。

ご指摘頂いたとおり、エラーの可能性はありそうです。
左上のセルだけ指定するというアイデアを使わせて頂きたく思います。

また、ご推察の通り
『ブック毎に異なるけれどブック内では固定の範囲で、値が等しいかのチェックを行いたい』
というのが目的です。
ただ、実は定型シートではなく、PDFを元に加工を施したブックになります。
加工からチェックまでボタン一つで行うことを想定しており、今回のチェックは最終段階でした。
今回いただいた回答で一通りのことはできましたので
今から見直しをし、改善していこうと思います。

改めて、ご回答ありがとうございました。
後ほどベストアンサーをさせて頂きます。

お礼日時:2017/05/10 14:33

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

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

このQ&Aと関連する良く見られている質問

Qエクセルのマクロや関数について、ランダムに抽出する方法を探しています

エクセルのマクロや関数について、ランダムに抽出する方法を探しています。

例えばシート1のA列には
1:かっこいい
2:レザー
3:男性用
4:カラー豊富
5:手帳型
6:シンプル
7:~
と言ったよう文字列があり

同じシート1のB列には
1:かわいい
2:花柄
3:カラー豊富
4:レザー
5:手帳型
6:クロコダイル調
7:~

といったような文字が各セルに入力されているとします。
それぞれの列の1行目はテーマのようになっていて
これをシート2で 「かっこいい」を選択してマクロボタンを押したり関数などで
シート1の文字列からランダムで「かっこいい」の列のワードを3つとか4つピックアップして
シート2でかっこいいを選択した横のセルなどに表示させたいのです。

とても分かりにくくて申し訳無いのですが、
テーマに沿ったキーワードが大量にあり、
別シートにてテーマを選択するとそのテーマに沿ったキーワードが複数ピックアップされるような仕組みを模索しています。


もしお分かりになる方、なにかヒント的なものでも思いついた方がいればお教えいただければと思います。何卒よろしくお願いいたします。

エクセルのマクロや関数について、ランダムに抽出する方法を探しています。

例えばシート1のA列には
1:かっこいい
2:レザー
3:男性用
4:カラー豊富
5:手帳型
6:シンプル
7:~
と言ったよう文字列があり

同じシート1のB列には
1:かわいい
2:花柄
3:カラー豊富
4:レザー
5:手帳型
6:クロコダイル調
7:~

といったような文字が各セルに入力されているとします。
それぞれの列の1行目はテーマのようになっていて
これをシート2で 「かっこいい」を選択してマクロボタンを...続きを読む

Aベストアンサー

> 各列にどんどん無限に足されていくので
Excelの列数自体が有限ですから 無限に増えることはありません。
あまり条件を無駄に広げるのは良くないと思います。

Sub Macro1()
Dim xKey As String, i As Long, tf As Boolean
Dim xRng As Range, yRng As Range, y As Range
Dim lr As Long, lc As Long, ac As Long
Dim xStr As String
Const xCnt As Integer = 3 '抽出数

With ThisWorkbook.Worksheets("Sheet2")
xKey = .Range("A1").Value
Set yRng = .Range("B1").Resize(, xCnt)
End With

With ThisWorkbook.Worksheets("Sheet1")
lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
tf = False
For i = 1 To lc
If .Cells(1, i).Value = xKey Then
tf = True
ac = i
Exit For
End If
Next i
If tf = False Then
MsgBox "該当するキーワードがありません。", vbCritical
Exit Sub
End If
lr = .Cells(.Rows.Count, ac).End(xlUp).Row
If lr - 1 <= xCnt Then
MsgBox "候補が規定数未満です", vbCritical
Exit Sub
End If
Set xRng = .Range(.Cells(2, ac), .Cells(lr, ac))
End With

For Each y In yRng
Do
y = xRng(WorksheetFunction.RandBetween(1, lr))
Loop Until WorksheetFunction.CountIf(yRng, y) = 1
Next y
Set xRng = Nothing: Set yRng = Nothing
End Sub

> 各列にどんどん無限に足されていくので
Excelの列数自体が有限ですから 無限に増えることはありません。
あまり条件を無駄に広げるのは良くないと思います。

Sub Macro1()
Dim xKey As String, i As Long, tf As Boolean
Dim xRng As Range, yRng As Range, y As Range
Dim lr As Long, lc As Long, ac As Long
Dim xStr As String
Const xCnt As Integer = 3 '抽出数

With ThisWorkbook.Worksheets("Sheet2")
xKey = .Range("A1").Value
Set yRng = .Range("B1").Resize(, xCnt)
End W...続きを読む

Qユーザ定義型は定義されてません

こんばんは
実行すると「ユーザ定義型は定義されてません」と表示されます。
どなたかわかる方おしえてください。
Sub m()
Dim a As New NotesSession
・・・

End Sub

Aベストアンサー

参考になるかな?

セッションオブジェクトを作成する
https://www.ibm.com/support/knowledgecenter/ja/SSVRGU_8.5.3/com.ibm.designer.domino.main.doc/H_ACCESSING_THE_DOMINO_OBJECTS_THROUGH_COM_CREATING.html

QVBA コンパイルエラーの解消法

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示のため実行ができません。
ご指摘、よろしくお願いいたします。

Sub kopipe1() '施工体制台帳
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sb As Long
Dim m As Long
Dim p As Long
Dim c As Long
Dim i As Long
Dim end1 As Long

Set sh = Worksheet("sheet1")
Set sh1 = Worksheet("施工体制台帳 (下請け) ")


end1 = sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
sb = 1
p = 1

For i = 2 To end1 Step 1
sb = sb + 1
c = cell(p, 9)

sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
sh.cell(sb, 3).Copy Destination:=.sh1.Range(c).Offset(2, 27) '代表者名
sh.cell(sb, 4).Copy Destination:=.sh1.Range(c).Offset(4, 1) '郵便番号
sh.cell(sb, 5).Copy Destination:=.sh1.Range(c).Offset(5, 1) '住所
sh.cell(sb, 6).Copy Destination:=.sh1.Range(c).Offset(6, 24) '電話番号
sh.cell(sb, 7).Copy Destination:=.sh1.Range(c).Offset(13) '業種1
sh.cell(sb, 8).Copy Destination:=.sh1.Range(c).Offset(14, 12) '許可者1
sh.cell(sb, 9).Copy Destination:=.sh1.Range(c).Offset(14, 15) '区分1
sh.cell(sb, 10).Copy Destination:=.sh1.Range(c).Offset(14, 17) '許可1-1
sh.cell(sb, 11).Copy Destination:=.sh1.Range(c).Offset(14, 20) '許可1-2
sh.cell(sb, 12).Copy Destination:=.sh1.Range(c).Offset(14, 27) '許可年月日
sh.cell(sb, 13).Copy Destination:=.sh1.Range(c).Offset(16) '業種2
sh.cell(sb, 14).Copy Destination:=.sh1.Range(c).Offset(17, 12) '許可者2
sh.cell(sb, 15).Copy Destination:=.sh1.Range(c).Offset(17, 15) '区分2
sh.cell(sb, 16).Copy Destination:=.sh1.Range(c).Offset(17, 17) '許可2-1
sh.cell(sb, 17).Copy Destination:=.sh1.Range(c).Offset(17, 20) '許可2-2
sh.cell(sb, 18).Copy Destination:=.sh1.Range(c).Offset(17, 27) '許可年月日2
sh.cell(sb, 19).Copy Destination:=.sh1.Range(c).Offset(21, 28) '健康保険
sh.cell(sb, 20).Copy Destination:=.sh1.Range(c).Offset(22, 28) '厚生年金保険
sh.cell(sb, 21).Copy Destination:=.sh1.Range(c).Offset(23, 28) '雇用保険
sh.cell(sb, 22).Copy Destination:=.sh1.Range(c).Offset(25, 3) '現場代理人指名
sh.cell(sb, 23).Copy Destination:=.sh1.Range(c).Offset(29, 7) '主任技術者氏名
sh.cell(sb, 24).Copy Destination:=.sh1.Range(c).Offset(31, 3) '資格内容
sh.cell(sb, 25).Copy Destination:=.sh1.Range(c).Offset(33, 3) '安全衛生責任者
sh.cell(sb, 26).Copy Destination:=.sh1.Range(c).Offset(25, 26) '安全衛生推進者
sh.cell(sb, 27).Copy Destination:=.sh1.Range(c).Offset(27, 26) '雇用管理責任者
sh.cell(sb, 28).Copy Destination:=.sh1.Range(c).Offset(29, 26) '専門技術者名
sh.cell(sb, 29).Copy Destination:=.sh1.Range(c).Offset(31, 26) '技術資格内容

p = p + 62
Exit For
Next i
End Sub

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示...続きを読む

Aベストアンサー

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
とりあえず、Cells と sh1 のコンマは取るけれども、
sh1.Range(c).Offset(2, 1) これでは可読性を落とすばかりで分かりません。

これ自体を直すよりは、最初から作り直したほうが早そうです。
たぶん、一覧で横に並んでいるものを、別のシートの各場所に振り替えていくわけで、それが、ページごとになっているというわけでしょう。

まず、 sh1.cells(sb, 2).Copy ですが、
その列の2 を変数にすべきですね。

受ける側が、Offset で書かれてしまうと、手がつけられなくなってしまいます。

sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")

このようにまとめてしまい、以下のように纏めたものから呼び出すようにします。
しかし、実際にやってみると不具合が生じるので、それを配列で渡すようにします。

注:以下は、私の想像で書かれたものであって、実際に合っているのかは分かりません。
このようなスタイルにしてみたらという、あくでもこちらの提案です。

'//
Sub Test1()
 Dim Rng As Range
 Dim i As Long, j As Long, sb As Long
 Dim c As Variant
 Dim sh As Worksheet, sh1 As Worksheet
 Set sh = Worksheets("sheet1")
 Set sh1 = Worksheets("施工体制台帳 (下請け)")

 
 Set Rng = sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")
 
 end1 = sh.Cells(Rows.Count, 2).End(xlUp).row
 
 i = 2
 sb = 2
 For j = 1 To end1
 a = (j - 1) * 62 + 1
  For Each c In Rng.Offset((j - 1) * 62 + 1)
   c.Value = sh.Cells(sb, i).Value
   DoEvents
   i = i + 1
  Next
  i = 2
  sb = sb + 1
 Next
End Sub

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).C...続きを読む

QExcelを使って行列変換をしたい(大量件数)

先日質問させていただいたものです。
さらなる加工が必要になりました。

例えば、
◆test
aaaaaa
iiiiiiiiiiiii
uuuuu
eeeee
ooooo
◆test2
kaaaaa
kiiiiiiiiiii
kuuuuu
keeeee
kooooo
...

これらのデータを
◆test aaaaaa
    iiiiiiiiiiiiii
    uuuuuu
eeeeee
oooooo
◆test2 kaaaaa
     kiiiiiiiiiii
     kuuuu
     keeeee
     koooooo

に変換はできたのですが、今度は
◆test aaaaaaaa iiiiiiiiiii uuuuuuuuuuu eeeeeee oooooo
◆test2 kaaaaaa kiiiiiiiii kuuuuuuuuu keeeeee koooooooo

のように変換する必要がでてしまいました。

マクロなどで一括で変換できないでしょうか。
当方知識が乏しいため困っております。

先日質問させていただいたものです。
さらなる加工が必要になりました。

例えば、
◆test
aaaaaa
iiiiiiiiiiiii
uuuuu
eeeee
ooooo
◆test2
kaaaaa
kiiiiiiiiiii
kuuuuu
keeeee
kooooo
...

これらのデータを
◆test aaaaaa
    iiiiiiiiiiiiii
    uuuuuu
eeeeee
oooooo
◆test2 kaaaaa
     kiiiiiiiiiii
     kuuuu
     keeeee
     koooooo

に変換はできたのですが、今度は
◆test aaaaaaaa iiiiiiiiiii uuuuuuuuuuu eeeee...続きを読む

Aベストアンサー

こんにちは!

別シートに表示しても良いですか?
元データはSheet1のA列にあり、Sheet2に表示するとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If InStr(.Cells(i, "A"), "◆") > 0 Then
cnt = cnt + 1
wS.Cells(cnt, "A") = .Cells(i, "A")
Else
wS.Cells(cnt, Columns.Count).End(xlToLeft).Offset(, 1) = .Cells(i, "A")
End If
Next i
End With
End Sub

こんな感じではどうでしょうか?m(_ _)m

こんにちは!

別シートに表示しても良いですか?
元データはSheet1のA列にあり、Sheet2に表示するとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If InStr(.Cells(i, "A"), "◆") > 0 Then
cnt = cnt + 1
wS.Cells(...続きを読む

QプログラミングにおいてOrの使い方がいまいち理解できません。 どなたかご教授お願い致します。

プログラミングにおいてOrの使い方がいまいち理解できません。
どなたかご教授お願い致します。

Aベストアンサー

仮に、a or b であれば、
a 真、b 真 → 真
a 真、b 偽 → 真
a 偽、b 真 → 真
a 偽、b 偽 → 偽

となります。
一つでも真があれば、結果は真となります。

Q【VBA】IF文 複数(ネスト)の時の処理について

こんにちは。
if文についておしえてください。
以下のようなマクロがあるとします。

変数 tensuuに-1をいれて実行すると①→②のように動作し「入力エラー」と表示されます。
tensuuに120を入れて実行すると①´→②´の順に動作し「入力エラー1」と表示されます。

どして、-1のときは入力エラー1にはいかず入力エラーにいくのでしょうか?
120のときは入力エラーにはいかず入力エラー1にいくのでしょうか?

動きがよくわかりません。
IF文とELSEはどういう紐づけがされているのでしょうか?

よろしくおねがいいたします。
   
Sub t()
tensuu = -1
If tensuu >= 0 Then '①
If tensuu <= 100 Then '①´
If tensuu >= 80 Then
MsgBox "合格"
Else
MsgBox "不合格"
End If
Else
MsgBox "入力エラー1" '②´
End If
Else
MsgBox "入力エラー" '②
End If
End Sub

こんにちは。
if文についておしえてください。
以下のようなマクロがあるとします。

変数 tensuuに-1をいれて実行すると①→②のように動作し「入力エラー」と表示されます。
tensuuに120を入れて実行すると①´→②´の順に動作し「入力エラー1」と表示されます。

どして、-1のときは入力エラー1にはいかず入力エラーにいくのでしょうか?
120のときは入力エラーにはいかず入力エラー1にいくのでしょうか?

動きがよくわかりません。
IF文とELSEはどういう紐づけがされているのでしょうか?

よろし...続きを読む

Aベストアンサー

If 〜 Then 〜 Else 〜 End If
で1セットです。

ネスト(入れ子)になったIF文というのは、 Then 〜 とか Else 〜 の〜の部分にIf文がくるものです。
ですから、外のIfを越えてしまうことはありません。
よって、一番内側から見ていけば、構造がはっきりします。


一番内側から見ます。

If tensuu >= 80 Then
MsgBox "合格"
Else
MsgBox "不合格"
End If

が1セットです。
これを 「文1」とすると元のプログラムは

If tensuu >= 0 Then '①
If tensuu <= 100 Then '①´
「文1」
Else
MsgBox "入力エラー1" '②´
End If
Else
MsgBox "入力エラー" '②
End If

となります。この状態で「一番内側」を見ると

If tensuu <= 100 Then '①´
「文1」
Else
MsgBox "入力エラー1" '②´
End If
です。これを「文2」とすると

If tensuu >= 0 Then '①
「文2」
Else
MsgBox "入力エラー" '②
End If


余談ですが
この例の場合、外側2つは、判定内容と処理とが離れてしまい、見辛いのは確かです。
if 条件 Then A Else B は if not条件 Then B Else A と同じ、ということから、Thenでの処理とElseでの処理を入れかえれば、
条件の直ぐ下の処理が来るので、見易さが格段によくなります。

If tensuu < 0 Then '① ' tensuu<0 は not (tensuu>=0)と同じ
MsgBox "入力エラー" '②
ElseIf tensuu > 100 Then '①´
MsgBox "入力エラー1" '②´
ElseIf tensuu >= 80 Then
MsgBox "合格"
Else
MsgBox "不合格"
End If ' ElseIfで継いでいるので、ネストにはなっていない

If 〜 Then 〜 Else 〜 End If
で1セットです。

ネスト(入れ子)になったIF文というのは、 Then 〜 とか Else 〜 の〜の部分にIf文がくるものです。
ですから、外のIfを越えてしまうことはありません。
よって、一番内側から見ていけば、構造がはっきりします。


一番内側から見ます。

If tensuu >= 80 Then
MsgBox "合格"
Else
MsgBox "不合格"
End If

が1セットです。
これを 「文1」とすると元のプログラムは

If tensuu >= 0 Then '①
If tensuu <= 100 Then '①´
「文1」
Else
MsgBox "入力エラー1" '②´
...続きを読む

Qエディタ って?

テキストエディタ という言葉が使われましたが、何を表しているのでしょうか?

Aベストアンサー

ワープロの簡易版みたいな感じで、ほぼWindows のメモ帳のようなものです。文字サイズ、罫線とか図名を操作するような機能はありません。テキストのみを編集(エデット)するソフトです。

Qマクロの「SaveAs」でエラーが出るのを解消したいです(再)

下記のエラーが出ます、似たようなもので新規ファイルで保存できたのですが
今回は出来ない状態になってしまいました。
ちょこちょこマクロ使うのですが、初心者で解決できません。
マクロ先生のご指導をお願いします。
※コピーされたシートが新ファイルで開かれた状態でエラー表示となります。


「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」


'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト出力()
Dim ws1
Set ws1 = Worksheets("チェック一覧")
Dim m As Long
m = 3
Dim ws2
Set ws2 = Worksheets("予算データ")

Dim sm As String

Dim ws3

Dim sn

'チェック一覧シートのNo.が無くなるまで処理する
Do Until ws1.Cells(m, 1) = ""

Application.ScreenUpdating = False


If ws1.Cells(m, 4) = "" Then
'ナンバーがある場合は部門等をチェック一覧(ws1)→フォーム(ws2)に転記する
Else
ws2.Cells(2, 2) = ws1.Cells(m, 4)

'各部署のシート名をsmにセットする
sm = ws1.Cells(m, 2)
Set ws3 = Worksheets(sm)

'予算フォーム(ws2)の行変数「s」と各部署シート(ws3)の行変数「n」
Dim s
s = 4
Dim n
n = 9
Dim cnt
cnt = 1

Do Until n = 44
If ws3.Cells(n, 23) = 0 Then

'各数値等を各部署のシート(ws3)→フォーム(ws2)に転記する
Else

ws2.Cells(s, 1) = cnt
ws2.Cells(s, 3) = 6100
ws2.Cells(s, 4) = 0
ws2.Cells(s, 5) = ws3.Cells(3, 4)
ws2.Cells(s, 6) = ws3.Cells(5, 8)

ws2.Cells(s, 7) = ws3.Cells(n, 4)
ws2.Cells(s, 8) = ws3.Cells(n, 24)
ws2.Cells(s, 9) = ws3.Cells(n, 25)
ws2.Cells(s, 10) = ws3.Cells(n, 26)
ws2.Cells(s, 11) = ws3.Cells(n, 27)
ws2.Cells(s, 12) = ws3.Cells(n, 28)
ws2.Cells(s, 13) = ws3.Cells(n, 29)
ws2.Cells(s, 14) = ws3.Cells(n, 31)
ws2.Cells(s, 15) = ws3.Cells(n, 32)
ws2.Cells(s, 16) = ws3.Cells(n, 33)
ws2.Cells(s, 17) = ws3.Cells(n, 34)
ws2.Cells(s, 18) = ws3.Cells(n, 35)
ws2.Cells(s, 19) = ws3.Cells(n, 36)
s = s + 1
cnt = cnt + 1

End If

n = n + 1

Loop
'予算データに転記されたので出力する

ws2.Copy

' ↓↓↓↓↓この下の「SaveAs」がエラーになります。↓↓↓↓↓

ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText

ActiveWindow.Close

ActiveWorkbook.Close savechanges:=False


'フォームに転記した情報をクリア
ws2.Select
Range(Cells(4, 1), Cells(44, 19)).Select
Selection.ClearContents


End If

m = m + 1


Loop

ws1.Select

MsgBox MESSAGE_FINISH

End Sub

下記のエラーが出ます、似たようなもので新規ファイルで保存できたのですが
今回は出来ない状態になってしまいました。
ちょこちょこマクロ使うのですが、初心者で解決できません。
マクロ先生のご指導をお願いします。
※コピーされたシートが新ファイルで開かれた状態でエラー表示となります。


「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」


'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト...続きを読む

Aベストアンサー

No1の方が指摘されているように、
ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText
のときの、 ws2.Cells(s, 5).Valueの値が不正な可能性があります。

この行の直前で、
msgbox("<" & ws2.Cells(s, 5).Value & ">")
を行い、ws2.Cells(s, 5).Valueの内容を確認しては、いかがでしょうか。

QExcel2013のVBAについて質問です。

チェックボックスではなく、□と■をダブルクリックで交互に表示したいのですが、よく方法が分かりません。※Excel初心者です。

自分なりに調べて下記を試してみてうまくいったのですが、セルの結合した箇所をダブルクリックすると実行時エラーがでてしまいます。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A1:AO300")) Is Nothing Then Exit Sub
Cancel = True
If Target.Value = "□" Then
Target.Value = "■"
ElseIf Target.Value = "■" Then
Target.Value = "□"
End If
End Sub

なにか良い方法はあるでしょうか?

Aベストアンサー

「If Target.Count <> 1 Then Exit Sub」あたりを最初のほうへ加えればよいと思います。

Qボタン一個で表示非表示切り替えマクロについて教えてください。 長文失礼します。マクロ初心者です。 ま

ボタン一個で表示非表示切り替えマクロについて教えてください。
長文失礼します。マクロ初心者です。
まず画面は以下の通りです。

ー A B C ・・
1 取引名 区分 費目
2 ◯システム 前期 円
3 空白 後期 円
4 空白 実績
ーーーーーーーーーーーーーーーーーーーーー
5 ▲システム 前期
6 空白 後期
7 空白 実績
ーーーーーーーーーーーーーーーーーーーーー

・ (★3行ずつ×10〜15コ分続く)
・ (★取引名がないとこは3行とも空白)
ーーーーーーーーーーーーーーーーーーー
20 小計 前期計
21 後期計
22 合計
23 実績計 (★小計欄は4行)
ーーーーーーーーーーーーーーーーーーーーーー
ここまでで1項目、(運用、保守などで区切っています)
次は保守の、同じのが。という風に1000行以上続きます。

別のファイルの取引no.と一致したら費目金額を反映させるマクロを取り込みボタンに設定中なので、
このフォーマットは変えられません。

そして、今回作成しなければならないのが、
表示非表示切り替えボタンです。
3行の一番上に取引名が入り、下2行は空白です。
一番上に取引名が入ってなかったら、以下の3行まとめて非表示/表示を切り替えたいんです。
現状、基本は1項目につき3行ずつ×10ですが
取引名が多数あるものはその分増やしているので統一はしていません。

また、各項目1つでも取引名があれば小計欄は非表示しない。
0だったら小計欄も非表示にする。
というルールです。


先方のお願いは
ボタン一個で、表示をクリックしたら表示され、ボタンの名前は非表示に変わり、非表示をクリックしたら非表示になり、名前は表示に、ということなのですが、


全然できてないのですが、
私が今考えていたコードは

If 切り替え.Caption = ”表示” Then
For i = 2 To LastRow Step 3
★まずここで、3行ずつ回すも、小計欄は4行なのでどうしたらいいのか
続き

If Cells(i,1) <> ”” And _
Cells(i,1) <> ”小計” Then
icnt = icnt + 1
EndIf
値があったらカウントし
後に、icnt>=1 Then
小計欄は残す、という流れをイメージしたのですが…


If Cells(i,1)= ”” Then
Rows(i).Hidden

If Cells(i,1) = ”小計” Then
If icnt>=1 Then
という流れにする場合、
もし残すなら、
次の項目からまたスタートとなるにはどうすればいいのか…
非表示の場合まとめて4行はアクティブセル+3という式にしたらいいのか、、
すみませんがもしよろしければコードをご教示ください。

ボタン一個で表示非表示切り替えマクロについて教えてください。
長文失礼します。マクロ初心者です。
まず画面は以下の通りです。

ー A B C ・・
1 取引名 区分 費目
2 ◯システム 前期 円
3 空白 後期 円
4 空白 実績
ーーーーーーーーーーーーーーーーーーーーー
5 ▲システム 前期
6 空白 ...続きを読む

Aベストアンサー

こんにちは

ご質問文で一番わからないのが、項目と次の項目の間は隙間なく連続しているのか、空白行や再度タイトルが記されていたりしないのかといったことでしょうか。
空白行がある場合は、きちんと行数が決まっているのか、気まぐれに1行だったり2行だったりするのかということ。


はっきりしないので、コードは示せませんが、少しは考え方のヒントにでもなれば・・・

方法はいろいろあると思いますが、ひとまとまりで考える行数が一定ではないので、ご提示のようにFORループで一律にStep 3としたのではうまくいかないと思います。

一例として、調べる対象の行(先頭行)を変数rwとして、順に見ていくものと考えた場合

 rw = 2 '←対象行の初期値
 Do While rw <= LastRow
  If Cells(rw, 1).Value = "小計" Then
   '小計の場合の処理
   ' ~~~
   rw = rw + 4 '←次の行(4でよいのか不明ですが)
  Else
   '3行セットの場合の処理
   ' ~~~
   rw = rw + 3 '←次の行
  End If
 Loop

のような考え方にすれば、対象の行数が異なる場合でも、条件分けして処理をすることで、次に参照する行までの行数を変えることが可能です。
上の例では、小計欄の4行の1行目には必ず「小計」と記されていて、それで識別しても良いとの保証があるものと仮定しています。(取引名には「小計」というものは絶対に存在しないなど)

こんにちは

ご質問文で一番わからないのが、項目と次の項目の間は隙間なく連続しているのか、空白行や再度タイトルが記されていたりしないのかといったことでしょうか。
空白行がある場合は、きちんと行数が決まっているのか、気まぐれに1行だったり2行だったりするのかということ。


はっきりしないので、コードは示せませんが、少しは考え方のヒントにでもなれば・・・

方法はいろいろあると思いますが、ひとまとまりで考える行数が一定ではないので、ご提示のようにFORループで一律にStep 3としたのではうま...続きを読む


人気Q&Aランキング