Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

151 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【79444】Re:シート上で、複数合計をだす

γ - 17/10/21(土) 19:03 -


	引用なし

	パスワード

無駄な全文引用はしないようにしてください。

そして、
>そもそも、特別なことがなぜ最初のA店舗にだけ発生しているのか。
といった事に対する説明はいただけないのですか？
またいくつか提案もしています（式を埋め込む等）。
これらについてもあなたの感想、考えなどを書いてもらいたいですね。

・ツリー全体表示


	【79443】Re:シート上で、複数合計をだす

ノンボ

- 17/10/21(土) 18:39 -


	引用なし

	パスワード

▼γ さん：
>前提が違っているかも知れないが、使えるなら使ってみてください。
>
>Sub test()
>　　Dim rng　　 As Range
>　　Dim a　　　 As Range
>　　Dim rng1　　As Range
>　　Dim lastRow As Long
>　　
>　　Set rng1 = Range("A1").End(xlDown).Offset(3)
>　　lastRow = Cells(Rows.Count, 1).End(xlUp).Row
>　　Set rng = Range(rng1, Cells(lastRow, 1)) _
>　　　　　　　.Offset(0, 2).SpecialCells(xlCellTypeConstants)
>　　
>　　For Each a In rng.Areas
>　　　　With a
>　　　　　　.Cells(1).Offset(.Rows.Count).Value = WorksheetFunction.Sum(.Cells)
>　　　　End With
>　　Next
>End Sub
>
>Sub test2()
>　　Dim rng　　 As Range
>　　Dim lastRow As Long
>　　Dim k　　　 As Long
>　　
>　　lastRow = Cells(Rows.Count, 1).End(xlUp).Row
>　　Set rng = Range("A1", Cells(lastRow, 1)) _
>　　　　　　　.Offset(0, 2).SpecialCells(xlCellTypeConstants)
>　　
>　　For k = 2 To rng.Areas.Count
>　　　　With rng.Areas(k)
>　　　　　　.Cells(1).Offset(.Rows.Count).Formula = _
>　　　　　　　 "=Sum(" & .Cells.Address(False, False) & ")"
>　　　　End With
>　　Next
>End Sub
>
>レイアウトの提示がなかったのは残念。
>以下のような疑問が生じないように求めたものだが、
>人の言うことに耳を貸さない方のようです。
>・A列には店舗名が重複して入力されているものと仮定
>・一行目だけのデータではないものと仮定（Set rng1 = Range("A1").End(xlDown).Offset(3)が不適当の懼れ）
>・A店舗だけされている「品目集計」の意味が説明されなかった。
>
>そもそも、特別なことがなぜ最初のA店舗にだけ発生しているのか。
>汎用性を持たせる必要はないのか。
>
>アドホックな対応をするなら、コード対応ではなく、ワークシートを直せばよいのではないか。
>もし手作業でSUM関数を使った計算式がA店舗の合計値セルに埋められているなら、
>A店舗を特別視する必要はないはず。提示のロジックで対応可能だったはず。
>
>なお、結果数値を書き込む方式だと、データの一部変更などがあって
>処理をやりなおす必要がもし出てきた場合には、再処理ができない。
>結果が定数値とみなされて計算結果が変わってくる。
>だから、式を埋め込んだ方がよいかもしれない。
>
>なお、前のスレッドであったマナさんの助言にもトライされたほうがよいと
>思います。
ご教授大変ありがとうございました。
とても役に立ちました。私のＶＢＡはまだ未熟です。
とても感謝します。　ありがとうございました。

・ツリー全体表示


	【79442】Re:シート上で、複数合計をだす

γ - 17/10/21(土) 12:05 -


	引用なし

	パスワード

前提が違っているかも知れないが、使えるなら使ってみてください。

Sub test()
　　Dim rng　　 As Range
　　Dim a　　　 As Range
　　Dim rng1　　As Range
　　Dim lastRow As Long
　　
　　Set rng1 = Range("A1").End(xlDown).Offset(3)
　　lastRow = Cells(Rows.Count, 1).End(xlUp).Row
　　Set rng = Range(rng1, Cells(lastRow, 1)) _
　　　　　　　.Offset(0, 2).SpecialCells(xlCellTypeConstants)
　　
　　For Each a In rng.Areas
　　　　With a
　　　　　　.Cells(1).Offset(.Rows.Count).Value = WorksheetFunction.Sum(.Cells)
　　　　End With
　　Next
End Sub

Sub test2()
　　Dim rng　　 As Range
　　Dim lastRow As Long
　　Dim k　　　 As Long
　　
　　lastRow = Cells(Rows.Count, 1).End(xlUp).Row
　　Set rng = Range("A1", Cells(lastRow, 1)) _
　　　　　　　.Offset(0, 2).SpecialCells(xlCellTypeConstants)
　　
　　For k = 2 To rng.Areas.Count
　　　　With rng.Areas(k)
　　　　　　.Cells(1).Offset(.Rows.Count).Formula = _
　　　　　　　 "=Sum(" & .Cells.Address(False, False) & ")"
　　　　End With
　　Next
End Sub

レイアウトの提示がなかったのは残念。
以下のような疑問が生じないように求めたものだが、
人の言うことに耳を貸さない方のようです。
・A列には店舗名が重複して入力されているものと仮定
・一行目だけのデータではないものと仮定（Set rng1 = Range("A1").End(xlDown).Offset(3)が不適当の懼れ）
・A店舗だけされている「品目集計」の意味が説明されなかった。

そもそも、特別なことがなぜ最初のA店舗にだけ発生しているのか。
汎用性を持たせる必要はないのか。

アドホックな対応をするなら、コード対応ではなく、ワークシートを直せばよいのではないか。
もし手作業でSUM関数を使った計算式がA店舗の合計値セルに埋められているなら、
A店舗を特別視する必要はないはず。提示のロジックで対応可能だったはず。

なお、結果数値を書き込む方式だと、データの一部変更などがあって
処理をやりなおす必要がもし出てきた場合には、再処理ができない。
結果が定数値とみなされて計算結果が変わってくる。
だから、式を埋め込んだ方がよいかもしれない。

なお、前のスレッドであったマナさんの助言にもトライされたほうがよいと
思います。

・ツリー全体表示


	【79441】Re:２枚目のシートの特定のセルの値を違...

マナ - 17/10/20(金) 19:32 -


	引用なし

	パスワード

▼初心者XXXXYYYY さん：

>ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets(2).Cells(i, 1) & ".xlsx"
>上の行で進まなくなってしまいます。

エラーですか？
どんなメッセージですか。

・ツリー全体表示


	【79440】Re:A列の数式のシェイプを一括作成するマ...

VBA初心者 - 17/10/20(金) 11:57 -


	引用なし

	パスワード

▼マナさん：

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

提示いただきました修正をし、実行したところ、A列の数式を文字列としてオートシェイプ内に記入していましたので、更に、
Selection.Characters.Text = rcode(i) 　
の個所を
Selection.Formula = rcode(i)
にすることで、望む結果が得られました。

お時間をいただき、ありがとうございました。

・ツリー全体表示


	【79439】Re:シート上で、複数合計をだす

ノンボ

- 17/10/20(金) 8:02 -


	引用なし

	パスワード

▼γ さん：
>データの例を示したほうが早く回答が得られると思います。
>行番号、列番号を明記したレイアウトを示してください。
>
>> Ａ店舗だけが品目集計してあります。
>意味がわかりません。説明をしてください。
>
>また、コードは手打ちではなく、VBEからコピーペイストしてください。
rさんさっそくご返事いただきましてありがとうございます。
説明がうまく伝わらずもうしわけありません。
あらためて説明させていただきます。

ワークシト上に、複数店舗データーがあります。Ａ列に店舗名、Ｂ列に品目名、Ｃ列に金額があります。Ｃ列の金額の合計をだすために下記コードを作成しました。

Sub test()
　　Dim Rng As Range
　　Dim a As Range
　　On Error Resume Next
　　With ActiveSheet.UsedRange
　　　　Set Rng = .Columns(3).SpecialCells(xlCellTypeConstants)
　　End With
　　On Error GoTo 0
　　If Rng Is Nothing Then Exit Sub
　　For Each a In Rng.Areas
　　　　With a
　　　　　　.Cells(1).Offset(.Rows.Count).Value = WorksheetFunction.Sum(.Cells)
　　　　End With
　　Next
End Sub
これですと、シート上すべての店舗の合計がでます。編集したいのは、シート上の2店舗めからの合計をだしたいのです。下記部分を編集するのだと思いますが、
With ActiveSheet.UsedRange
　　　　Set Rng = .Columns(3).SpecialCells(xlCellTypeConstants)
　　End With
２店舗めからの行は定まっていません。ご教授よろしくお願いします。

・ツリー全体表示


	【79438】Re:２枚目のシートの特定のセルの値を違...

初心者XXXXYYYY - 17/10/19(木) 23:40 -


	引用なし

	パスワード

▼マナさん：
>▼初心者XXXXYYYY さん：
>
>>ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count,1).End(xlUp).Row
>
>ここは、Sheet1でよいのですか？

すみません。
Sheet2です。

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets(2).Cells(i, 1) & ".xlsx"
上の行で進まなくなってしまいます。

・ツリー全体表示


	【79437】Re:選択した行の空欄の項目の抽出

マナ - 17/10/19(木) 22:47 -


	引用なし

	パスワード

▼tomitomi さん：

叩き台です。

Option Explicit

Sub test()
　　Dim wsS As Worksheet
　　Dim wsD As Worksheet
　　Dim i As Long, j As Long, m As Long, n As Long
　　Dim flg As Boolean
　　
　　Set wsS = Sheets("Sheet1")
　　Set wsD = Worksheets.Add
　　
　　m = 1
　　For i = 2 To wsS.Cells(Rows.Count, 1).End(xlUp).Row Step 3
　　　　flg = False
　　　　n = 1
　　　　For j = 2 To wsS.Cells(1, 2).End(xlToRight).Column
　　　　　　If wsS.Cells(i, j).Borders(xlDiagonalUp).LineStyle <> xlContinuous Then
　　　　　　　　If wsS.Cells(i, j).Value = "" Then
　　　　　　　　　　n = n + 1
　　　　　　　　　　wsD.Cells(m, n).Value = j - 1
　　　　　　　　　　flg = True
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　
　　　　If flg Then
　　　　　　wsD.Cells(m, 1).Value = wsS.Cells(i, 1).Value
　　　　　　m = m + 1
　　　　End If
　　　　
　　Next
　　
End Sub

・ツリー全体表示


	【79436】Re:選択した行の空欄の項目の抽出

γ - 17/10/19(木) 22:31 -


	引用なし

	パスワード

データの例を示したほうが早く回答が得られると思います。
行番号、列番号を明記したレイアウトを示してください。

・ツリー全体表示


	【79435】Re:シート上で、複数合計をだす

γ - 17/10/19(木) 22:30 -


	引用なし

	パスワード

データの例を示したほうが早く回答が得られると思います。
行番号、列番号を明記したレイアウトを示してください。

> Ａ店舗だけが品目集計してあります。
意味がわかりません。説明をしてください。

また、コードは手打ちではなく、VBEからコピーペイストしてください。

・ツリー全体表示


	【79434】Re:２枚目のシートの特定のセルの値を違...

マナ - 17/10/19(木) 21:56 -


	引用なし

	パスワード

▼初心者XXXXYYYY さん：

>ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count,1).End(xlUp).Row

ここは、Sheet1でよいのですか？

・ツリー全体表示


	【79433】２枚目のシートの特定のセルの値を違うブ...

初心者XXXXYYYY - 17/10/19(木) 21:07 -


	引用なし

	パスワード

２枚目のシートの一列目のセルの名前を、新しいブックにつけて保存する方法を試していますが上手く行きません。
どうしたら良いでしょうか？

Sub create()
For i = 2 To ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count,1).End(xlUp).Row
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets(2).Cells(i, 1) & ".xlsx"
ActiveWorkbook.Close
Next
End Sub

・ツリー全体表示


	【79432】シート上で、複数合計をだす

ノンボ

- 17/10/19(木) 20:47 -


	引用なし

	パスワード

　よろしくお願いします。

　シートに複数の店舗データーがあり、上から（Ａ店、Ｂ店・・・）、Ｂ列に品目、Ｃ列に金額があります。Ａ店舗だけが品目集計してあります。Ｂ店、Ｃ店にはSUMで、金額合計をだしたいのですが、以前教えていただきました下記コードを書きました。
Sub Test()
　　 dim rng as range
　　 dim a as range
　　 on Error REsume Next
　　 With range("A30",Activecell.Specialcells(xlLastcell))
　　 End With
　　 On Error GOTo 0
　　 If rng is Nothing Then Exit Sub
　　 For Each a in Rng Areas
　　 With a
　　 .Cells(1).Offset(.Rows.count).value=WorksheetFunction.Sum(.Cells)
　　 End With
　End sub

　ここで、Ａ店舗の最終行から3行目よりセル範囲を指定したいのですが、任意のせる
("A30")ではなく、変数で行うにはどのようにコードを編集したらよいか、ご教授ください。よろしくお願いします。

・ツリー全体表示


	【79431】選択した行の空欄の項目の抽出

tomitomi - 17/10/19(木) 20:06 -


	引用なし

	パスワード

初めて質問させていただきます。また、VBAは初心者です。丸投げになってしまうかもしれないのですが、なにかアドバイスいただければ幸いです。。。Ｂ列に商品名、３段目にチェック項目が書かれている表があります。すんだ項目に済を入力しています。一つの商品に３行使っていて、済をいれるセルも結合してあったり、してなかったりです。また、しなくていい項目のところには罫線で斜線が引かれています。やりたいことは、選択した商品が、どこがまだ済んでいないのかを別シートに抽出したいです。下記りんごを選択した場合、りんご　1,3,5みたいな感じです。　　　　1　　　　2　　　　3　　　　4　　　　5 　　　　　　　　　　　　　　　　　　　　りんご　　　　　済　　　　　　　　済　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　みかん　　　　　済　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　表や、やりたいことがうまくご説明できなくて、申し訳ございません、何卒、お力添えいただける方がいましたら、よろしくお願いいたします。

・ツリー全体表示


	【79430】Re:A列の数式のシェイプを一括作成するマ...

マナ - 17/10/19(木) 18:34 -


	引用なし

	パスワード

▼VBA初心者さん：

>　　　　rcode(i) = ActiveSheet.Cells(i, 1).Value

この１行を、修正したらどうなりますか。

rcode(i) = ActiveSheet.Cells(i, 1).Formula

・ツリー全体表示


	【79429】(Access) CopyFromRecordsetの逆

りった - 17/10/19(木) 12:22 -


	引用なし

	パスワード

CopyFromRecordsetで1行文丸ごと、Excelにエクスポートできるようですが、インポートする関数は有りますでしょうか？

Dim adoRs As ADODB.Recordset
ws.Range("A1").CopyFromRecordset adoRs
の、逆がほしいです。(1行丸ごとupdate)

・ツリー全体表示


	【79428】A列の数式のシェイプを一括作成するマクロ

VBA初心者 - 17/10/19(木) 11:11 -


	引用なし

	パスワード

下記マクロは、A列の文字列のシェイプを一括作成するものですが、
この「文字列」を「数式」にしたいです。
即ち、A列の数式のシェイプを一括作成するマクロにしたいのです。
そうなった場合の、マクロの完成形をご教示いただけないでしょうか。
改行やシェイプの形等は、変えずにお願いします。

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub A列の文字列のシェイプを一括作成()
　　　
　　Dim shapeType As String
　　Dim shapeW As Integer
　　Dim shapeH As Integer
　　Dim kaigyo As Integer
　　　
　　'=== シェイプの形と大きさを決めて下さいここから ===
　　shapeType = msoTextOrientationHorizontal　 'シェイプの形
　　shapeW = 130　　　　　　　　'シェイプの大きさ（横幅）
　　shapeH = 25　　　　　　 'シェイプの大きさ（高さ）
　　kaigyo = 1　　　　　　　　　　 '何個おきに改行させるか
　　'=== シェイプの形と大きさを決めて下さいここまで ===
　　　
　　Dim maxRow As Integer
　　maxRow = Range("A65536").End(xlUp).Row
　　　
　　Dim myShape As shape
　　　　　
　　Dim rcode() As String 'シェイプ内の文字列その1
　　ReDim rcode(maxRow)
　　　
　　Dim shapeRow As Integer 'シェイプを作る行
　　Dim shapeCol As Integer 'シェイプを作る列
　　shapeRow = 0
　　　
　　For i = 1 To maxRow
　　　　'A列の値を取得
　　　　rcode(i) = ActiveSheet.Cells(i, 1).Value
　　　
　　　　'シェイプを作る位置を決める。
　　　　If i Mod kaigyo = 0 Then '何個おきに改行させるか
　　　　　　shapeCol = 5
　　　　　　shapeRow = shapeRow + shapeH
　　　　End If
　
　　　
　　'オートシェイプを作成する
　　Set myShape = ActiveSheet.Shapes.AddShape(Type:=shapeType, _
　　　　Left:=shapeCol, Top:=shapeRow, Width:=shapeW, Height:=shapeH)
　　　
　　'文字列を入れる
　　myShape.Select
　　Selection.Characters.Text = rcode(i)　'A列のみ
　　　
　　shapeCol = shapeCol + shapeW
　　　
　　Next
　
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

・ツリー全体表示


	【79427】Re:ユーザー定義関数の中でセルの値を参...

γ - 17/10/19(木) 8:11 -


	引用なし

	パスワード

要望どおりのものがなくても、
返事くらいするのがマナーじゃないですか？

・ツリー全体表示


	【79426】Re:Findステートメントからsumで合計金額...

ノンボ

- 17/10/18(水) 20:45 -


	引用なし

	パスワード

ご返答いただきまして、ありがとうございます。参考にさせていただきます。
大変ありがとうございました。

・ツリー全体表示


	【79425】Re:Findステートメントからsumで合計金額...

ノンボ

- 17/10/18(水) 20:22 -


	引用なし

	パスワード

▼まっつわんさん：
>この例題でEndプロパティでセル範囲を特定するのは難しいのではないでしょうか？
>ついでに検索を繰り返すのも煩雑でしょう。
>
>今回の場合はジャンプ機能でセル範囲を検索する方法が良いと思います。
>
>Sub test()
>　　Dim Rng As Range
>　　Dim a As Range
>　　
>　　On Error Resume Next
>　　With ActiveSheet.UsedRange
>　　　　Set Rng = .Columns(3).SpecialCells(xlCellTypeConstants)
>　　End With
>　　On Error GoTo 0
>　　If Rng Is Nothing Then Exit Sub
>　　
>　　For Each a In Rng.Areas
>　　　　With a
>　　　　　　.Cells(1).Offset(.Rows.Count).Value = WorksheetFunction.Sum(.Cells)
>　　　　End With
>　　Next
>End Sub
>
>また、標準機能で小計行は挿入できますが、
>そちらを使わないのはなぜでしょうか？
ご返答いただきまして、ありがとうございます。編集しまして、作成してみます。
大変ありがとうございました。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

151 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free