VBAでマクロを組もうとしています。
作ろうとしているのは、フォルダを指定すると、そのフォルダの中に入っているワークブック全てのシートから特定の名前のシートだけ、別のブックにコピーされるというものです。
(例 1というフォルダの中にあ、い、うの3つのワークブックが入っているとすると、その3つのワークシートからAという名前のシートのみコピーされて、えという名前のワークブックにまとめられる。)

プログラムに関して初心者のため手探りで組んでみたのですが、「オブジェクト変数が…」というエラーが出てしまいます。

どこに原因があるのか教えていただけませんか。
コピペしたため改行など変かもしれません。
すみません。



Sub Sample()
Dim sFile As String
Dim sWB As Workbook, dWB As Workbook
Dim dSheetCount As Long
Dim sSheetCount As Long
Dim n As Integer
Dim i As Long

Const SOURCE_DIR As String = "C:\Users\A
Const DEST_FILE As String = "C:\Users\B.xls"

Dim sWork As Worksheet
Dim dWork As Worksheet

Dim tmp As Variant



Application.ScreenUpdating = False


sFile = Dir(SOURCE_DIR & "*.xls")
'SOURCE_DIR=「A」ファイルでその中に入ってるブックの名前を sFile とする

'フォルダ内にブックがなければ閉じる
If sFile = "" Then Exit Sub

'コピー先のブックを作成。dWBという名前のブックを加える。
Set dWB = Workbooks.Add

'dWBのシート数を取得。コピー先のシート数を表すときはdSheetCountを使う。
'コピー元のシート数はsSheetCountを使う。

dSheetCount = dWB.Worksheets.Count
sSheetCount = sWB.Worksheets.Count

Do
'コピー元のブックを開く
Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile)


'コピー元のファイルに「りんご」という文字があるか確認する。
'もし文字があったらコピー先のブックにコピーする。

'コピー元のワークシート数の何番目なのか表記はnで表す。
'コピー元のワークシートのことをsWorkと表す。
'コピー先のワークシートのことをdWorkと表す。

Set sWork = sWB.Worksheets
Set dWork = dWB.Worksheets

For n = 1 To sWB.Worksheets.Count
If InStr("sWork(sSheetsCount).name", "りんご") <> 0 Then
sWork("りんご").Copy After:=dWB.Worksheets(dSheetCount)

'コピー先のシート名をコピー元のブックの名前に置き換える
'コピー先のシート数+1の数だけシートを確認して、
'「りんご」という文字があったものだけ置き換える。
For i = 1 To dSheetCount + 1
If InStr("dWork(i).name", "りんご") <> 0 Then

'置き換える名前はコピー元のブック名を_で区切った(1)にあたるものにする。
tmp = Split("sWb.Name", "_")
dWork(i).Name = tmp(1)
End If
Next
End If
Next



'コピー元ファイルを保存しないで閉じる。

'ワークブック"Book1.xls"を保存しないで閉じる
'Sub CloseWorkbook()
'Workbooks("Book1").Close SaveChanges:=False
'End Sub
sWB.Close SaveChanges:=False



'次のブックのファイル名を取得
sFile = Dir()
Loop While sFile <> ""

'コピー先ブック作成時にあったシートを削除
Application.DisplayAlerts = False
For i = dSheetCount To 1 Step -1
dWB.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True

'コピー先ブックを保存して閉じる
dWB.SaveAs Filename:=DEST_FILE
dWB.Close

Application.ScreenUpdating = False
End Sub

質問者からの補足コメント

  • 回答ありがとうございます!

    sSheetcountのところに、Set sWB=ActiveWorkbook と追加したところ、無事にそこの部分を通ることができました!

    dWBについてもdSheetcountとしているので、ActiveWorkbookとおこうとしたのですが、「オブジェクトはこのプロパティ、またメソッドをサポートしていない」と出てしまいました。

    dWBや他の部分についてはなにも書かなくていいということなのでしょうか?

      補足日時:2017/06/15 14:53

A 回答 (3件)

>>dWBについてもdSheetcountとしているので、ActiveWorkbookとおこうとしたのですが、「オブジェクトはこのプロパティ、またメソッドをサポートしていない」と出てしまいました。




dWBはアウトプットするワークブック名であり既に
Set dWB = Workbooks.Add
とやってるから追加記述は要りません。
    • good
    • 0
この回答へのお礼

ありがとうございました。

ActiveWorkbookはそのような意味だったのですね。理解が足りませんでした。
ありがとうございます!

お礼日時:2017/06/15 19:55

>sSheetcountのところに、Set sWB=ActiveWorkbook と追加したところ、無事にそこの部分を通ることができました!



そりゃ通るだろうけど、間違ってます。

その後の
'コピー元のブックを開く
で初めてsWBは定義されるから、その後に移動しないと
いけません。

そもそも、変数の名前がどうしてそのアルファベットなのか
意識してますか?
Source (コピー元の)WorkBookと Destination(コピー先の)
WorkBookというつもりです、多分ね。

>dWBについてもdSheetcountとしているので、ActiveWorkbookとおこうとしたのですが
何をいってるのかな?
Set dWB = Workbooks.Add ’ブックを新規作成してdWBにセットしてますよね。
dSheetCount = dWB.Worksheets.Count ’その新規ブックのシート数を代入してます。

てことで、ActiveWorkbookの出る幕は考えられないです。
でも、何を記述したんでしょうね?
「オブジェクトはこのプロパティ、またメソッドをサポートしていない」と出てしまいました。
が、気にはなります。
    • good
    • 0
この回答へのお礼

なるほど…まだまだ理解が足りていないのだと実感しました。
おそらくSetを別のところに書いてしまったためだと思われます。

削除し書き直したところ、なんとか動かすことができました。
ありがとうございました。

お礼日時:2017/06/15 19:54

全部は見てませんが


sSheetCount = sWB.Worksheets.Count ①

sWBに何も設定していないでいきなり使ってるから。

具体的なブック名をセットしないといけない。

sWBが今のアクティブブックの意味で使いたいなら
set sWB=ActiveWorkbookと言う文が①の前に必要。
    • good
    • 0

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

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

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

Qエクセルの、マクロとは何ですか?

エクセルの、マクロとは何ですか?

Aベストアンサー

エクセルの裏に貼り付けてあるVBと言うプログラムです。
ここにコードィングすれば、そのエクセルを開いて使う事が出来ます。
使う:プログラムを実行できる。

下は例です。
Sheet1のA列をSheet2のA列へ1個置きに転送する

Sub WK()
Dim CNT As Long
Dim END1 As Long
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
END1 = Sh1.Range("B65536").End(xlUp).Row

For CNT = 2 To END1 STEP 2
Sh2.Range("A" & CNT).Value = Sh1.Range("A" & CNT1).Value
Next CNT
E1:
Application.StatusBar = False
End Sub

エクセルの裏に貼り付けてあるVBと言うプログラムです。
ここにコードィングすれば、そのエクセルを開いて使う事が出来ます。
使う:プログラムを実行できる。

下は例です。
Sheet1のA列をSheet2のA列へ1個置きに転送する

Sub WK()
Dim CNT As Long
Dim END1 As Long
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
END1 = Sh1.Range("B65536").End(xlUp).Row

For CNT = 2 To END1 STEP 2
Sh2...続きを読む

Qマクロで消去したいです

たびたび同じ質問をしてしまい申し訳ありません
以前教えてもらった
Sub Sample()

Dim c As Range, cbx As Object
Dim rw As Long
Dim t As Single, h As Single, w As Single
Dim y As Single, v As Boolean, f As Boolean

For rw = 6 To 15
Set c = Cells(rw, 1)
t = c.Top
h = t + c.Height
w = c.Width
f = False

' Form Control
For Each cbx In ActiveSheet.CheckBoxes
y = cbx.Top + cbx.Height / 2
If t < y And y < h And cbx.Left < w Then
f = True
If cbx.Value = xlOn Then v = True Else v = False
Exit For
End If
Next cbx

' ActiveX Control
If Not f Then
For Each cbx In ActiveSheet.OLEObjects
If TypeName(cbx.Object) = "CheckBox" Then
y = cbx.Top + cbx.Height / 2
If t < y And y < h And cbx.Left < w Then
f = True
v = cbx.Object.Value
Exit For
End If
End If
Next cbx
End If

If f And v Then
Cells(rw, 3).Resize(, 3).ClearContents
Cells(rw, 16).Resize(, 2).ClearContents
End If
Next rw

End Sub
でシート「操作画面」のC13:E13,P13:Q13 C15:E15,P15:Q15は消去することができました
それを応用して別シート「集計」のI7:I12 K7:K12も合わせて消去しようかと思ったのですが上手く
動作しませんでした

大変申し訳ないのですが、また、ご指導のほどよろしくお願いいたします

たびたび同じ質問をしてしまい申し訳ありません
以前教えてもらった
Sub Sample()

Dim c As Range, cbx As Object
Dim rw As Long
Dim t As Single, h As Single, w As Single
Dim y As Single, v As Boolean, f As Boolean

For rw = 6 To 15
Set c = Cells(rw, 1)
t = c.Top
h = t + c.Height
w = c.Width
f = False

' Form Control
For Each cbx In ActiveSheet.CheckBoxes
y = cbx.Top + cbx.Height / 2
If t < y And y < h And cbx.Left < w Then
f ...続きを読む

Aベストアンサー

前回回答者です。

最初に、前回の説明と重複になってしまいますが・・・
https://oshiete.goo.ne.jp/qa/9807697.html

説明にもありますように、通常はセルとチェックボックスの関係をきちんと取れるようにしておいてから、マクロを作成するものと思います。
その意味において、前回のNo1様、No3様の回答は関係性を確かなものにする方法を提示なさっています。

No2の回答は、それらの情報が与えられないので、しかたなく見た目から推測する方法で処理したものですので、正確性や効率性の点であまり良いものとは言えません。
また、チェックボックスも複数の種類が想定でき、どちらなのかが不明でしたので、両方を考慮しましたが、実際には(常識的に)どちらか一方だけの利用であると推測できますので、結果的に残り半分のコードは不要ということになります。
さらに、きちんと関係性が取れている場合は、位置関係から探す必要もなくなるので、コードも大幅に短くできるはずですが、不明な状況でしたので、ひとまず冗長なコードであっても提示しておけば、後は、質問者様がアレンジなさるであろうことを期待しての回答でした。


今回のご質問で、
・それを応用して~~
・〇〇も合わせて消去しようかと~
・上手く動作しませんでした
「応用する」、「うまく動作しない」という情報だけから推理しようとしても、あまりにも可能性が広がりすぎてしまって皆目見当がつきません。

多少なりともヒントになりそうな情報として記せそうなのは、前回の回答で「セルの内容を消去している」部分は
> Cells(rw, 3).Resize(, 3).ClearContents
> Cells(rw, 16).Resize(, 2).ClearContents
の2行である、ということぐらいでしょうか。
(この部分に関しては、前回のNo3様と、たまたま同様の記述になっています)
ANo3様のコードの方が、シートを明記する形式で対象を指定していますので、より明確な記述方法になっていると言えるかもしれません。

ちなみに
>別シート「集計」のI7:I12 K7:K12を消去する
という部分だけであれば、
 Worksheets("集計").Range("I7:I12,K7:K12").ClearContents
のような記述で実現できるはずと思います。

前回回答者です。

最初に、前回の説明と重複になってしまいますが・・・
https://oshiete.goo.ne.jp/qa/9807697.html

説明にもありますように、通常はセルとチェックボックスの関係をきちんと取れるようにしておいてから、マクロを作成するものと思います。
その意味において、前回のNo1様、No3様の回答は関係性を確かなものにする方法を提示なさっています。

No2の回答は、それらの情報が与えられないので、しかたなく見た目から推測する方法で処理したものですので、正確性や効率性の点であまり良いものとは...続きを読む

Qexcelで条件に合うよう、複数のセルの合計を求めたい

例えば、次のように並んでいるセルの数値があるとします。

1515
2748
540
5509
2195
680
7142
305
5042
530
667
325
9950
4800

その合計が30000以上で、かつ、最小の数字となるよう、複数のセルを選択したいと思いますが、これを実現できる関数はありますか?

Aベストアンサー

いわゆる「ナップザック問題」と呼ばれる種類の問題になると思います。

14個を選択する/しないなら、総当りしても16384個ですから、力技でも行けるかも。
画像を参考に、
1行目にデータの数値を横並び。
2行目に0~13の固定値を右から
3行目に2の0乗~2の13乗(8192)の固定値を右から
A列に0~16383の固定値
で、

B4:O16387の範囲に、
B4:=MOD(INT($A4/B$3),2)
をコピペして2進数の各桁の値を

P4:P16387の範囲に、
P4:=SUMPRODUCT($B$1:$O$1,B4:O4)
をコピペして、2進数の各桁のビットとデータの数値の積和

で、全16384通りの計算が行われるので、A4:末尾を選択して並べ替えすると、
合計が30002となる、
1515
2748
2195
680
7142
305
667
9950
4800
が確認できるとか。

--
もっと数値の数が増えると、この方法では厳しいので、

ナップザック問題をExcelで解く
http://www.geocities.co.jp/SiliconValley-Oakland/8139/

みたいなプログラムで解くような事になります。


条件が違うのでプログラムはそのまま使えませんが、似た質問。

エクセルで、「袋詰め問題」を解きたい - Excel(エクセル) 解決済 | 教えて!goo
https://oshiete.goo.ne.jp/qa/1255891.html

いわゆる「ナップザック問題」と呼ばれる種類の問題になると思います。

14個を選択する/しないなら、総当りしても16384個ですから、力技でも行けるかも。
画像を参考に、
1行目にデータの数値を横並び。
2行目に0~13の固定値を右から
3行目に2の0乗~2の13乗(8192)の固定値を右から
A列に0~16383の固定値
で、

B4:O16387の範囲に、
B4:=MOD(INT($A4/B$3),2)
をコピペして2進数の各桁の値を

P4:P16387の範囲に、
P4:=SUMPRODUCT($B$1:$O$1,B4:O4)
をコピペして、2進数の各桁のビットとデータの数値の積...続きを読む

Qエクセルでマクロ。他のパソコンではエラーになる。

セル値からフォルダー名を取得して、ある場所にフォルダーを作成するというものです。
下記を私のPCでは問題なく動作するのですが、
別のPCからは「パスが見つかりません」とエラーになります。
デバッグは「MkDir mydir」を指しています。
すべてのPCから実行可能にするためにはどの様にすればよろしいのでしょうか?
ご教授願います。
win10、excel2013

Sub フォルダー作成()

Dim mydir As String
Dim i As Integer

For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
mydir = "C:\Users\user\Desktop\test\" & Cells(i, 17).Value
If Dir(mydir, vbDirectory) = vbNullString Then MkDir mydir
Next i
MsgBox "完了しました"

End Sub

Aベストアンサー

ファイルやフォルダを扱うなら、FileSystemObjectが便利と思います。
作成したいフォルダのパスをmydirとして、それが存在しなければ作成します。
これでもだめでしょうか?

Sub test()
Dim mydir As String, i As Long
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
mydir = "C:/Google ドライブ/T/01_T/02_受注/" & Cells(i, 17).Value
If FSO.FolderExists(mydir) = False Then
FSO.CreateFolder mydir
End If
Next i
MsgBox "完了しました"
Set FSO = Nothing
End Sub

ファイルやフォルダを扱うなら、FileSystemObjectが便利と思います。
作成したいフォルダのパスをmydirとして、それが存在しなければ作成します。
これでもだめでしょうか?

Sub test()
Dim mydir As String, i As Long
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
mydir = "C:/Google ドライブ/T/01_T/02_受注/" & Cells(i, 17).Value
If FSO.FolderExists(mydir) = False Then
...続きを読む

Qエクセルを私が開くと日付の表示がおかしくなる(他の人は問題なし)

会社でエクセルファイルを私が開くと日付の表示がおかしくなります。(他の人は問題ないです)

具体的には、平成○年○月○日という表示されるよう設定されファイル作成されているはずが、
私が開くと○月○日平成○○年と表示されます。

このようなファイルが一つではありませんので、私のPCでの「エクセル」の設定がおかしいのかと。

勿論、毎度毎度、気が付く度に手作業で直せますが、根本的にリセットしたいです。
気が付かないで印刷し取引先に送ったら注意を受けてしまいました。

原因・修正にお心当たりの方、ご教示の程宜しくお願い致します。

Aベストアンサー

参考になりますかね
https://oshiete.goo.ne.jp/qa/2408312.html
https://matome.naver.jp/odai/2141732667925396001

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の内容を確認しては、いかがでしょうか。

Qエクセル で 例えば 19.07.05と入力した場合

自動的に Hを頭に付けて H19.07.05 と表示させるにはどうしたら良いでしょうか?
教えて下さい。

Aベストアンサー

表示だけなら書式設定で可能ですが、
あくまで見た目しか変わらないので、日付として計算式に利用するには1手間2手間かけなければならなくなりますよ。
計算に用いるなら、Hも含めて日付として入力し、書式設定を日付の和暦にするのが一番簡単だと思います。

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〖エクセル〗MOD関数で、小さな数字を大きな数字で割り算した場合が理解できません

GOOの皆様いつもありがとうございます。
例えば1を2で割り算した場合は、0.5ですが、
MODした場合、余りの数はなぜ1になるのですか?
簡単に説明して頂ける方はいらっしゃいますか・・・

Aベストアンサー

>補足
そのとおりですね。
その例で言えば、10を3で割った余りは1です。
では、余った1を3で割るとどうなりますか?
3で割れないから1余ったのですよね?
なら、余りは1のままです。
割られる数が割る数より小さい正の値であれば、商は0、余りは割られる数そのままです。

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&Aを見た人がよく見るQ&A

人気Q&Aランキング