Excel VBA質問箱 IV

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

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


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

229 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77866】Re:規定数で区切るには

ウッシ - 16/1/15(金) 10:42 -


	引用なし

	パスワード

こんにちは

Sub test()
　　Dim sh1　As Worksheet
　　Dim sh2　As Worksheet
　　Dim wsh　As Worksheet
　　Dim r　　As Range
　　Dim s　　As Range
　　Dim i　　As Long
　　Dim j　　As Long
　　Const m　As Long = 3　　'規定数
　　
　　Set sh1 = Worksheets("Sheet1")
　　Set sh2 = Worksheets("Sheet2")
　　Set wsh = Worksheets.Add
　　
　　Application.ScreenUpdating = False
　　
　　sh2.UsedRange.Offset(1).ClearContents
　　
　　wsh.Range("A1:C1").Value = sh1.Range("A1:C1").Value
　　wsh.Range("D1").Value = "グループ"
　　
　　i = 2
　　For Each r In sh1.Range("A2", sh1.Range("A2").End(xlDown))
　　　　wsh.Cells(i, 1).Resize(r(1, 3), 3).Value = r.Resize(, 3).Value
　　　　i = i + r(1, 3)
　　Next
　　
　　j = wsh.Range("A" & Rows.Count).End(xlUp).Row
　　With wsh.Range("D2:D" & j)
　　　　.Formula = "=B2&INT((ROW()+" & m - 2 & ")/" & m & ")"
　　　　.Value = .Value
　　End With
　　
　　
　　wsh.Range("A1").CurrentRegion.Subtotal _
　　　　GroupBy:=4, Function:=xlCount, TotalList:=Array(3), _
　　　　Replace:=True, PageBreaks:=False, SummaryBelowData:=True
　　
　　Set s = wsh.Range("D2", wsh.Range("D2").End(xlDown).Offset(-1, 0)) _
　　　　　　　　　　.Offset(, -3).SpecialCells(xlCellTypeBlanks)
　　
　　For Each r In s
　　　　r.Offset(-1, 0).Resize(, 2).Copy _
　　　　　　sh2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
　　　　sh2.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
　　　　　　r.Offset(0, 2).Value
　　Next

　　With sh2.Range("C2", sh2.Range("C2").End(xlDown)).Offset(0, 1)
　　　　.Formula = "=IF(D1=" & m & ",C2,D1+C2)"
　　　　.Value = .Value
　　End With
　　
　　Application.DisplayAlerts = False
　　wsh.Delete
　　Application.DisplayAlerts = True
　　
　　Application.ScreenUpdating = True

End Sub

・ツリー全体表示


	【77865】Re:規定数で区切るには

β - 16/1/15(金) 10:12 -


	引用なし

	パスワード

▼karasu さん：

一例です。
勘違いあれば指摘願います。

Sub test()
　　DivItem 10
End Sub

Sub DivItem(cnt As Long)
　　Dim c As Range
　　Dim box As Long
　　Dim qtyIn As Long
　　Dim qtyBlc As Long
　　Dim qtySet As Long
　　Dim w As Variant
　　Dim dic As Object
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　For Each c In Sheets("Sheet1").Range("A1").CurrentRegion.Columns(1).Cells
　　　　If c.Row <> 1 Then
　　　　　　qtyIn = c.EntireRow.Range("C1").Value
　　　　　　qtyBlc = qtyIn
　　　　　　Do
　　　　　　　　If cnt - box >= qtyBlc Then
　　　　　　　　　　qtySet = qtyBlc
　　　　　　　　Else
　　　　　　　　　　qtySet = cnt - box
　　　　　　　　End If
　　　　　　　　
　　　　　　　　qtyBlc = qtyBlc - qtySet
　　　　　　　　w = c.EntireRow.Range("A1:C1").Value
　　　　　　　　w(1, 3) = qtySet
　　　　　　　　dic(dic.Count) = w
　　　　　　　　
　　　　　　　　box = box + qtySet
　　　　　　　　If box = cnt Then box = 0
　　　　　　　　
　　　　　　Loop While qtyBlc > 0
　　　　End If
　　Next
　　　　
　　　　　　　　　　　　　　
　　With Sheets("Sheet2")
　　　　.UsedRange.ClearContents
　　　　.Range("A1:C1").Value = Sheets("Sheet1").Range("A1:C1").Value
　　　　.Range("A2").Resize(dic.Count, 3).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
　　　　With .Range("D2").Resize(dic.Count)
　　　　　　.Formula = "=IF(MOD(SUM(C$2:C2)," & cnt & "),MOD(SUM(C$2:C2)," & cnt & ")," & cnt & ")"
　　　　　　.Value = .Value
　　　　End With
　　　　.Select
　　End With
　　　　
End Sub

・ツリー全体表示


	【77864】規定数で区切るには

karasu - 16/1/15(金) 6:13 -


	引用なし

	パスワード

いつもお世話になります。 sheet1 　　　　規定数　10　<==任意の数　　A　　　 B　　　 C 1　No　　種類　　数量 2　 1　　みかん　　 4 3　 2　　りんご　　12 4　 3　　バナナ　　17 5　 4　　　桃　　　30 6　 5　　いちご　 13 sheet2 　　A　　　B　　　C　　　D 1　No　　種類　　数量 2　 1　　みかん　　4　　 4 3　 2　　りんご　　6　　10 4　 2　　りんご　　6　　 6 5　 3　　バナナ　　4　　10 6　 3　　バナナ　　10　　10 7　 3　　バナナ　　3　　 3 8　 4　　　桃　　　7　　10 9　 4　　　桃　　　10　　10 10　4　　　桃　　　10　　10 11　4　　　桃　　　3　　 3 12　5　　いちご　　 7　　10 13　5　　いちご　　6　　 6 sheet1の表からsheet2に表のように規定数の数になった時に次の種類のものの残りの数からまた規定数まで表示。また規定数を超える場合は規定数(今回は10)ごとに行を追加して残りを表示するようにしたいのです。どうぞ宜しくお願いいたします。

・ツリー全体表示


	【77863】Re:CSVの書き出しについて

γ - 16/1/15(金) 4:06 -


	引用なし

	パスワード

今のコードでReplace関数を使って、"を""に置換すればいいんじゃないでしょうか。
ダブルクォーテーションの中のそれは、
二つで一つの意味となるので、
Replace(Cells(Row, col).Value, """", """""")
のような書き方になりますね。

タグ内と地の文章ではダブルクォーテーションの意味を区別するということなら
また別の工夫が必要になるけれど。

・ツリー全体表示


	【77862】CSVの書き出しについて

ネオン - 16/1/15(金) 0:05 -


	引用なし

	パスワード

現在シート内のデータをCSVとして書き出すマクロを作成しております。

条件として、
・各項目は「""」で囲まず、カンマ区切り
・出力したいデータには<tr bgcolor="#000000">のようなHTMLが含まれているが、
　これは<tr bgcolor=""#000000"">としたい
といったものです。

Open Path For Output As #fileNo
　　For row = 1 To lastrow
　　　　For col = 1 To lastcol
　　　　　　Print #fileNo, Cells(row, col) & ",";
　　　　Next
　　　　Print #fileNo, Cells(row, col)
　　Next
Close #fileNo

上記の様にPrintを使って出力したのですが、
そうするとHTMLタグのダブルクォーテーションの部分も<tr bgcolor="#000000">のまま出力されてしまいます。

かといってWriteで出力すると、<tr bgcolor=""#000000"">にはなりますが、項目が「""」で囲まれてしまいます。

色々と調べているのですが、どうしても解決できずにおります。
どのようにすればよいか助言いただけますと幸いです。
よろしくお願いします。

・ツリー全体表示


	【77861】Re:日本語入力システムについて

独覚 - 16/1/13(水) 11:43 -


	引用なし

	パスワード

日本語版の場合でも「Excelのオプション」-「言語」-「編集言語の選択」で「英語」が
「規定」になっていると入力規則のタブに「日本語入力」が表示されなくなるようです。

他の言語ではどうなるかまでは調べていません。

・ツリー全体表示


	【77860】Re:excel2003で作ったVBAの誤作動？バグ...

たろう - 16/1/13(水) 9:22 -


	引用なし

	パスワード

▼ichinose さん：

解決しました！
他の方の環境では再現されない誤作動だったので半分諦めてました。
ありがとうございました。

・ツリー全体表示


	【77859】Re:excel2003で作ったVBAの誤作動？バグ...

たろう - 16/1/13(水) 9:19 -


	引用なし

	パスワード

▼β さん：
長々と付き合ってくれてありがとうございました。

・ツリー全体表示


	【77858】Re:excel2003で作ったVBAの誤作動？バグ...

ichinose - 16/1/12(火) 21:31 -


	引用なし

	パスワード

▼たろうさん：
>ダブルクリックやコマンドボタンを使わないでマクロからユーザーフォームを開くと症状が出ないことは解ったんですがそれではあまりにも不便なんですよね。なにか替わりの方法などあればいいのですが
　Ontimeメソッドで試してみては　いかがですか？

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)
　　Application.OnTime Now(), "thisworkbook.ufmshow"
　　Cancel = True
End Sub
Sub ufmshow()
　　UserForm1.Show
End Sub

・ツリー全体表示


	【77857】Re:excel2003で作ったVBAの誤作動？バグ...

β - 16/1/12(火) 19:58 -


	引用なし

	パスワード

▼たろうさん：

なるほど。
UserFormモジュールは、このコードだけ（INITIALIZEもなし）なんですね。

こちらでは、アップされたコードだけで動かして障害が出ませんので
これ以上はお手伝いできませんねぇ。
他の方からのアドバイスがあればいいですね。

・ツリー全体表示


	【77856】Re:excel2003で作ったVBAの誤作動？バグ...

たろう - 16/1/12(火) 16:13 -


	引用なし

	パスワード

▼β さん：
>ところで、ユーザーフォームの機能が、CommandButton1をクリックして
>画面分割を行うだけということであれば、わざわざユーザーフォームを表示しなくても
>ダブルクリックで、直接、その処理を行えばよろしいのでは？

ダブルクリックでしたい動作が一つではないのでユーザーフォームにその動作を詰め込んでいるのでそういうわけにはいかないんですよね。

>もし、このユーザーフォームには、そのほかの様々な機能もある、また
>CommandButton1_Click　も、アップされたコードだけではなく、いろいろ記述されている
>ということであれば、コメントしましたように、ユーザーフォームモジュールをすべて
>アップされると、皆さんから新しい発見レスも寄せられるかもしれません。

いや他の機能もありますが、新しいブックに【77849】に書いたコードだけで問題が起きるので他のコードは関係ないと思います。他の動作は問題出ないんですよ。

・ツリー全体表示


	【77855】Re:excel2003で作ったVBAの誤作動？バグ...

β - 16/1/12(火) 15:29 -


	引用なし

	パスワード

▼たろうさん：

不思議ですねぇ。

ところで、ユーザーフォームの機能が、CommandButton1をクリックして
画面分割を行うだけということであれば、わざわざユーザーフォームを表示しなくても
ダブルクリックで、直接、その処理を行えばよろしいのでは？

もし、このユーザーフォームには、そのほかの様々な機能もある、また
CommandButton1_Click　も、アップされたコードだけではなく、いろいろ記述されている
ということであれば、コメントしましたように、ユーザーフォームモジュールをすべて
アップされると、皆さんから新しい発見レスも寄せられるかもしれません。

・ツリー全体表示


	【77854】Re:excel2003で作ったVBAの誤作動？バグ...

たろう - 16/1/12(火) 15:12 -


	引用なし

	パスワード

▼β さん：
なんでなんだろう？？うちの社内の他のPCでも全く同じ症状が出るので皆同じと思っていました。ダブルクリックやコマンドボタンを使わないでマクロからユーザーフォームを開くと症状が出ないことは解ったんですがそれではあまりにも不便なんですよね。なにか替わりの方法などあればいいのですが

>・どのシートのダブルクリックでも受ける　という仕様なんですね？

そういう仕様です。
見積書なんですが流れとしては、シート1で数量計算して、分割しシート2に転記して、もう一度ユーザーフォームを開いて合計を押すと自動計算されて、その時に分割が解除されるという流れです。ユーザーフォームには分割、自動計算、自動で範囲指定して印刷などいろいろ入れてあるのでどこでも開ける方が都合がいいんです。

>・すでに、画面が分割されている状態でユーザーフォームを表示させて分割すると
>　どんどんこままくというか、画面がたくさんできていきますけど
>　それはそれでいいのですね？

再分割という動作をすることはないのでいいのですが、他のブックを開いたままだと3つ以上に分割されるのでよくはないです。前回作ったときに、うまくいかなかったのでその点については諦めていました。

・ツリー全体表示


	【77853】Re:excel2003で作ったVBAの誤作動？バグ...

β - 16/1/12(火) 14:36 -


	引用なし

	パスワード

▼たろうさん：

はい。
こちらで検証した際にはシート1のシートモジュールに書いていたのですが
今回アップされた、Thisworkbookモジュールに変更しても、全く異常は発生していません。

ところで、本筋のコメントではないのですが

・どのシートのダブルクリックでも受ける　という仕様なんですね？
・すでに、画面が分割されている状態でユーザーフォームを表示させて分割すると
　どんどんこままくというか、画面がたくさんできていきますけど
　それはそれでいいのですね？

・ツリー全体表示


	【77852】Re:日本語入力システムについて

Jaka - 16/1/12(火) 14:28 -


	引用なし

	パスワード

ああ、入力規則のタブに
日本語入力ってのがないってことですね。
すみませんでした。

・ツリー全体表示


	【77851】Re:日本語入力システムについて

Jaka - 16/1/12(火) 14:22 -


	引用なし

	パスワード

こんにちは。

日本語入力システム　って？
IMEオンと違うんですか？
因みに2007だと。

オン

しか書いてありませんでした。
また、使っているのはOffice付属のOfficeIME2007です。

・ツリー全体表示


	【77850】Re:excel2003で作ったVBAの誤作動？バグ...

たろう - 16/1/12(火) 13:56 -


	引用なし

	パスワード

▼Jaka さん：
やはり駄目でした
わざわざありがとうございました。

・ツリー全体表示


	【77849】Re:excel2003で作ったVBAの誤作動？バグ...

たろう - 16/1/12(火) 13:51 -


	引用なし

	パスワード

▼β さん：

>実際にCommandButton をクリックした時に処理しているコードを
>そのままコピペで貼り付けてアップされてはいかがでしょう。
新しいブックに下のコードで誤作動が起きるんですがβさんの環境では起きないということなんでしょうか？

ThisWorkbookに

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)
　　UserForm1.Show
End Sub

UserForm1に

Private Sub CommandButton1_Click()
Sheet2に記入
End Sub

Module1に
Sub Sheet2に記入()
'
' Sheet2に記入 Macro
'
　　Application.ScreenUpdating = False
　　Unload UserForm1
　
　　Sheets("Sheet1").Select
　　ActiveWindow.NewWindow
　　Windows.Arrange ArrangeStyle:=xlArrangeStyleVertical, ActiveWorkbook:=True
　　Sheets("Sheet2").Select
　　Range("B40").Select
　
　　Application.ScreenUpdating = True
End Sub

・ツリー全体表示


	【77848】Re:excel2003で作ったVBAの誤作動？バグ...

Jaka - 16/1/12(火) 13:28 -


	引用なし

	パスワード

2013持っていないやつが、返信するもんじゃないな。
最近、エクセル触ってないし。

ひょっとしたら、97時代のおまじないが聞いたりして。
2013持ってないのでこれ以上想像できません。
ごめんなさい。

Cancel = True
ActiveCell.Activate

・ツリー全体表示


	【77847】Re:excel2003で作ったVBAの誤作動？バグ...

β - 16/1/12(火) 12:05 -


	引用なし

	パスワード

▼たろうさん：

jakaさんのレスで、セルの編集状態が悪さをしているのかなと思い
ためしに、アップされたまま、Cancel=true を入れない形のシートイベントでユーザーフォームを開きましたが
これも、全く問題ないですね。

不思議です。

実際にCommandButton をクリックした時に処理しているコードを
そのままコピペで貼り付けてアップされてはいかがでしょう。

・ツリー全体表示


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

229 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free