目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

┃ ┃一覧表示 ┃ ┃ ┃ ┃

11 / 14 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

【86】bykinさん作「ToolStar」 Version 3.00

谷誠之 - 05/2/12(土) 1:25 -


	引用なし

	パスワード

～添付ファイル～［削除されました］

VBA研究所主宰者の谷です。

bykinさん作「Tool★彡（ツールスター）」がみたびバージョンアップしました。
みなさん、ぜひお使いください。

※ReadMeから新機能の紹介部分を抜粋しておきます。

★彡テキスト変換 ★彡
選択したセル範囲のイメージ（枠線とセルの表示内容）を
テキスト形式に変換してクリップボードにコピーします。

★彡オブジェクト順序一括変更 ★彡
ワークシート／グラフシート／埋め込みグラフ内の
オブジェクトの順序を一括変更します。

・ツリー全体表示

【85】Re:Excelで１９００年は閏年

ちゃっぴ - 04/12/7(火) 23:32 -


	引用なし

	パスワード

▼Maro さん：
>　最近、介護保険関連のシステムを受注してＶＢＡで組んでいましたら、対象となる相手がお年寄りが多いためたまたま１００才を超える方がいらしてエクセル側で作成したデータをフォーム(VBA)で表示させると、エクセルでは１９００年を閏年と判断していることが分かり、1900.1.1～2.29（本当はない日）がフォーム(VBA)側では全て１日前になってしまいます。ご存じの方も当然いらっしゃるでしょうが、介護保険関係のデータをエクセルで管理していらっしゃる方も多いようですので、とりあえず投稿させていただきます。
>　マイクロソフトは以下で情報を公開しているようですが、根本的な解決をする気はなさそうです。
>
>http://support.microsoft.com/default.aspx?scid=kb;ja;214326

もとをたどれば、LotusのBugがそのまま生き残っていると
どこかで聞いたような･･･

・ツリー全体表示

【84】オートフィルタの絞込み

Jaka - 04/12/6(月) 9:24 -


	引用なし

	パスワード

下記のような住所データを
都道府県　→　市町村名　→　名前　と絞り込んでいくとすると

フォーム上にリストボックスが３個
リストボックス１ = 都道府県
リストボックス２ = 市町村名
リストボックス３ = 名前　　　　　として。

一応フィルタしっぱなしと後片付けするもの２つ。
内容はほとんど同じです。たぶん。
（３ヶ月ぐらい前にここの載せようとして、書いたんだけど覚えてません。）

Sheet1のデータ

Ａ　　Ｂ　　　　　　　　　Ｃ　　　　　Ｄ　　　　Ｅ
No,　氏名　　　　　　　　県　　　　市町村　　番地　←　ここ１行目。
1　　谷亮子　　　　　　東京都　　渋谷区　　　1549
2　　北島康介　　　　　　愛知県　　名古屋市　　1276
3　　釜飯豊　　　　　　　愛知県　　名古屋市　　1277
4　　どんぐりコロ　　　　愛知県　　春日井市　　5495
5　　ガイアボッタ　　　　千葉県　　鴨川市　　　1586
6　　栗原恵　　　　　　長野県　　松本市　　　156987
7　　大山加奈　　　　　　愛知県　　春日井市　　5496
8　　青木とめ　　　　　　秋田県　　秋田市　　　145000
9　　木村舞　　　　　　　長野県　　松本市　　　156
10　観月ありさ　　　　　東京都　　千代田区　　1567
11　阿部美里　　　　　　長野県　　諏訪市　　　123
12　漫画太郎　　　　　　東京都　　中央区　　　22
13　のびた　　　　　　　東京都　　中央区　　　23
14　改造ドパ　　　　　　東京都　　墨田区　　　999
15　伊藤ため　　　　　　秋田県　　秋田市　　　788
16　ケイン小杉　　　　　長野県　　八千穂　　　555
17　もたいまさこ　　　　長野県　　八千穂　　　322
18　猫が好き　　　　　　長野県　　八千穂　　　89
19　敬老の日　　　　　　東京都　　品川区　　　124
20　ウォーターボーイズ　秋田県　　面倒市　　　47
21　横山めぐみ　　　　　大阪府　　中央区　　　88888
22　ミルマスカラス　　　秋田県　　八郎潟　　　7777
23　Ｑ太郎　　　　　　　東京都　　中央区　　　24
24　遠隔ピーズ　　　　　東京都　　墨田区　　　998
25　インディオ　　　　　長野県　　松川村　　　3345

１、シート上のフィルタを戻す。
　　これ使えないので、消しました。
　　すみません。

２、シート上フィルタしたまま

標準モジュール

Public CE As Long　　'これ忘れないでね。

Sub 絞込み2()
　　Dim Ctl As Range, LbTb() As String, Cnt As Long
　　ActiveSheet.AutoFilterMode = False
　　CE = ActiveSheet.Range("C65536").End(xlUp).Row
　　ActiveSheet.Range("C1:C" & CE).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
　　CAE = Range("C2").End(xlDown).Row
　　Set Ctl = ActiveSheet.Range("C2:C" & CAE).SpecialCells(xlCellTypeVisible)
　　ActiveSheet.AutoFilterMode = False
　　ActiveSheet.ShowAllData
　　DoEvents
　　Cnt = 0
　　For Each ccc In Ctl
　　　　Cnt = Cnt + 1
　　　　ReDim Preserve LbTb(1 To Cnt)
　　　　LbTb(Cnt) = ccc
　　Next
　　UserForm2.ListBox1.List = LbTb
　　Set Ctl = Nothing
　　Erase LbTb
　　Application.ScreenUpdating = True
　　UserForm2.Show
End Sub

フォームモジュール

Private Sub ListBox1_Click()
　　 Dim CT2 As Range, Cel As Range, LB2tb() As String
　　 Application.ScreenUpdating = False
　　 ListBox2.Clear
　　 ListBox3.Clear
　　 If ActiveSheet.AutoFilterMode Then
　　　　ActiveSheet.AutoFilterMode = False
　　 End If
　　 LtW = ListBox1.List(ListBox1.ListIndex)
　　 Range("A1").AutoFilter field:=3, Criteria1:=LtW
　　 Set CT2 = Range("D2:D" & CE).SpecialCells(xlCellTypeVisible)
　　 ListBox2.Clear
　　 Cnt = 0
　　 For Each Cel In CT2
　　　　 On Error Resume Next
　　　　 mt = Application.Match(Cel, ListBox2.List, 0)
　　　　 If IsError(mt) Or mt = Empty Then
　　　　　　Cnt = Cnt + 1
　　　　　　ReDim Preserve LB2tb(1 To Cnt)
　　　　　　LB2tb(Cnt) = Cel
　　　　 End If
　　　　 ListBox2.List = LB2tb
　　　　 Err.Clear
　　　　 On Error GoTo 0
　　 Next
　　 Set CT2 = Nothing
　　 Erase LB2tb
　　 Application.ScreenUpdating = True
End Sub

Private Sub ListBox2_Click()
　　 Dim CT3 As Range, Cel As Range, LB3tb() As String, mt As Variant
　　 Application.ScreenUpdating = False
　　 ListBox3.Clear
　　 LtW = ListBox2.List(ListBox2.ListIndex)
　　 Range("A1").AutoFilter field:=4, Criteria1:=LtW
　　 Set CT3 = Range("B2:B" & CE).SpecialCells(xlCellTypeVisible)
　　 ListBox3.Clear
　　 Cnt = 0
　　 For Each Cel In CT3
　　　　 On Error Resume Next
　　　　 mt = Application.Match(Cel, ListBox3.List, 0)
　　　　 If IsError(mt) Or mt = Empty Then
　　　　　　Cnt = Cnt + 1
　　　　　　ReDim Preserve LB3tb(1 To Cnt)
　　　　　　LB3tb(Cnt) = Cel
　　　　 End If
　　　　 ListBox3.List = LB3tb
　　　　 Err.Clear
　　　　 On Error GoTo 0
　　 Next
　　 Set CT3 = Nothing
　　 Erase LB3tb
　　 Application.ScreenUpdating = True
End Sub

Private Sub ListBox3_Click()
　　MsgBox ListBox3.List(ListBox3.ListIndex)
End Sub

Private Sub CommandButton1_Click()
　　ActiveSheet.AutoFilterMode = False
　　Unload Me
End Sub

・ツリー全体表示

【83】Excelで１９００年は閏年

Maro - 04/12/6(月) 4:39 -


	引用なし

	パスワード

　最近、介護保険関連のシステムを受注してＶＢＡで組んでいましたら、対象となる相手がお年寄りが多いためたまたま１００才を超える方がいらしてエクセル側で作成したデータをフォーム(VBA)で表示させると、エクセルでは１９００年を閏年と判断していることが分かり、1900.1.1～2.29（本当はない日）がフォーム(VBA)側では全て１日前になってしまいます。ご存じの方も当然いらっしゃるでしょうが、介護保険関係のデータをエクセルで管理していらっしゃる方も多いようですので、とりあえず投稿させていただきます。
　マイクロソフトは以下で情報を公開しているようですが、根本的な解決をする気はなさそうです。

http://support.microsoft.com/default.aspx?scid=kb;ja;214326

・ツリー全体表示

【82】Re:bykinさん作「ToolStar」バージョンアッ...

谷誠之

- 04/11/30(火) 1:47 -


	引用なし

	パスワード

～添付ファイル～［削除されました］

VBA研究所主宰者の谷です。

>さてbykinさん作「Tool★彡（ツールスター）」がバージョンアップしました。
>みなさん、ぜひお使いください。

なんでも、バグがあったそうです。
ひとつ前のバージョンをダウンロードした方は、こちらを再度ダウンロードしてください。よろしくお願いします。

・ツリー全体表示

【81】Re:bykinさん作「ToolStar」バージョンアップ

谷誠之

- 04/11/29(月) 10:45 -


	引用なし

	パスワード

～添付ファイル～［削除されました］

VBA研究所主宰者の谷です。

最近、Jaka さんをはじめとするみなさんが、当「目安箱」を充実してくださっています。大変、ありがたいことです。

さてbykinさん作「Tool★彡（ツールスター）」がバージョンアップしました。
みなさん、ぜひお使いください。
以下は ReadMe からの抜粋です。

---

■各機能説明（詳細はヘルプにてご確認ください）

　登録後にExcelを起動すると、メニューに[Tool★彡]という項目が追加されます。
　メニューをクリックして必要な処理を選択してください。

　★彡セル選択一部解除 ★彡

　複数のセルをCtrlキーを押しながら順番に選択しているときに、間違って関係の
　ないセルを選択してしまったことはありませんか？
　一般機能には選択済セルの一部解除機能がないため、一旦すべての選択を解除し
　て一からやり直す必要があります。
　「セル選択一部解除」ではこのような場合に任意のセル範囲のみを選択解除する
　ことができます。
　また、指定したセルのみを選択解除することも可能です。
　　
　★彡セル交換 ★彡

　選択したセル範囲を同一シート内の別のセル範囲と交換します。

　★彡塗りわけ ★彡

　選択セル範囲を任意の２色で塗りわけます。
　大きな表などで使用すると表を見やすくすることができます。

　★彡セル色変更 ★彡

　選択範囲のセルの塗りつぶしの色を検索して、同じ色のセルをまとめて別の色に
　変更します。
　同一色で塗りつぶしたセル範囲が矩形以外の場合等に便利な機能です。

　★彡検索ジャンプ ★彡

　選択範囲の中で検索元セルと同じ内容（値／数式／書式）のセルを全て選択します。
　同じ値のセルや同じ塗りつぶし色のセルのみを選択することができます。

　★彡解析レポート ★彡

　ワークシートで使用されている数式を確認するためには、セルの表示を数式に変
　更することもできますが、数式はセルに入りきらないことが多く、確認しやすい
　とはいえません。
　また、条件付書式や入力規則は標準では一覧で確認する方法がありません。
　「解析レポート」では、アクティブなワークシートの数式／条件付書式／入力規
　則を新しいワークシートに一覧形式で書き出します。

　★彡画像変換 ★彡

　選択したセル範囲やオブジェクト（図形／グラフ等）を画像として保存します。
　対応フォーマットはGIF／JPEG／PNG／EMFです。
　保存後はペイント／InternetExplorer／拡張子に関連付けられたソフトで開くこ
　とができます。

　★彡縁取り罫線 ★彡

　選択セル範囲の縁に沿って罫線を引きます。

　★彡罫線→シェイプ変換 ★彡

　選択セル範囲のセルの罫線をオートシェイプの直線に変換します。
　直線の形状／色はできるだけ元の罫線に近いものにしています。

　★彡雲形シェイプ作成 ★彡

　選択セル範囲の縁またはあらかじめ作成したオートシェイプのフリーフォームの
　辺にそって半円弧を連続描画することにより、雲形のシェイプを作成します。

　　●雲形シェイプ作成＞選択セル範囲から
　　　選択範囲は複数でもかまいませんが、端セルを選択することはできません。

　　●雲形シェイプ作成＞フリーフォームから
　　　オートシェイプのフリーフォームを元にしているため、水平／垂直方向だけ
　　　でなく自由な形状の雲形を作成することができます。
　　　元になるフリーフォームは単一かつ直線のみで構成されている必要がありま
　　　す。閉じた形状である必要はありませんが、閉じていない場合でも変換後の
　　　雲形は閉じた形状になります。

■注意事項

※このアドインはExcel2000以降専用です。Excel97等の旧バージョンではお使いいただけません。

※「Windows2000+SP3」に「VisualStudio.net Professional 2003」をインストールしているＰＣで、アドイン登録後にExcelを起動させると、「VisualStudio.net Professional 2003」の設定画面が表示される事象が報告されています。
この場合は上記の設定画面に従い、.netのインストールDisc1を挿入すると自動設定処理が行われ、それ以降は上記のメッセージは表示されなくなります。
.netの設定をキャンセルした場合でも通常どおりご利用いただけますが、起動のたびに上記のメッセージが表示されてしまいますので、なるべく設定処理を実行するようにしてください。

・ツリー全体表示

【79】CSVファイルのデータ行数のカウント速度比べ

Jaka - 04/10/27(水) 15:47 -


	引用なし

	パスワード

２００３年１月ごろの郵政省の郵便番号表「Ken_all.csv」（１２１３３３行）で、アバウトな方法で比べてみました。
思ってたより差がでなくて１秒前後ぐらいの差しかないみたいでした。

最初、動いているかどうかも確認したかったので、セルにカウント数を書き込んでたら、遅さにビックリしてしまいました。
結果、私としてはどれでも良いんですが、Runtime使ったりするのは抵抗があるし、INputBで読み込むのは速い事はかなり速いんですが、変換して処理するってのも場合によっては面倒だし、結局は、これで飯食ってるわけでもないので、やっぱりどっちでも良いやって事です。

・普通のLine Input

Pen2.233　96M　セルへの書込有　　Pen2.233 96M　セルへの書込無
　70600行　0:02:53　　　　　　　　65536行　0:00:04
　70600行　0:02:37

Cel750　256M　セルへの書込有　　Cel750　256M　セルへの書込無
　65536行　0:02:17　　　　　　　　65536行　0:00:01
　65536行　0:02:38　　　　　　　　65536行　0:00:01

　　　　　　　　　　　　　　　　Cel750　256M　セルへの書込無
　　　　　　　　　　　　　　　　　121333行　0:00:02

・INputB_Instr

Pen2.233　96M　セルへの書込有　　Pen2 233 96M　セルへの書込無
　70600行　0:02:41　　　　　　　　65536行　0:00:05
　70600行　0:02:42　　　　　　　　65536行　0:00:02

Cel750　256M　セルへの書込有　　Cel750　256M　セルへの書込無
　65536行　0:02:38　　　　　　　　65536行　0:00:01
　65536行　0:02:37　　　　　　　　65536行　0:00:01

・FSO仕様

Pen2.233　96M　　　　　　　　　Cel750　256M　　　　　　　　　　Cel750 256M
　70600行　0:00:03　　　　　　　65536行　0:00:01　　　　　　　　121333行　0:00:02

Pen2 233 96M
　65536行　0:00:03
　65536行　0:00:02

---------------------------------------
Sub 普通のInput()
　　オープンファイル = Application.GetOpenFilename("Excelファイル (*.csv;*.txt), *.csv;*.txt")
　　STime = Now()
　　If オープンファイル <> False Then
　　　拡張子 = StrConv(Right(オープンファイル, 3), vbUpperCase)
　　　 Open オープンファイル For Input As #1
　　Else
　　　 End
　　End If
　　Do Until EOF(1)
　　　 Line Input #1, ReadDete
　　　 CSV全データ行数 = CSV全データ行数 + 1
　　　 'Range("A5").Value = CSV全データ行数　 'これがあると無いとの比較もしてみてください。
　　Loop
　　Close #1
　　Range("A5").Value = CSV全データ行数
　　Range("B5").Value = Format(STime - Now(), "hh:mm:ss")
　　MsgBox Format(STime - Now(), "hh:mm:ss") & vbLf & CSV全データ行数
End Sub

Sub INPUTB_inStr()
　　Dim RDM As String, RDM2 As String, RDM3 As String, CSV全データ行数 As Long
　　オープンファイル = Application.GetOpenFilename("Excelファイル (*.csv;*.txt), *.csv;*.txt")
　　STime = Now()
　　If オープンファイル <> False Then
　　　 Open オープンファイル For Input As #1
　　Else
　　　 End
　　End If
　　RDM = InputB(LOF(1), #1)
　　Close #1
　　RDM = StrConv(RDM, vbUnicode) '無いとまともな文字でない。
　　i = 1
　　Do
　　　 CC = InStr(i, RDM, vbLf)
　　　 If CC <> 0 Then
　　　　　CSV全データ行数 = CSV全データ行数 + 1
　　　　　'Range("A9").Value = CSV全データ行数　 'これがあると無いとの比較もしてみてください。
　　　　　On Error Resume Next
　　　　　i = CC + 1
　　　 End If
　　Loop Until CC = 0 Or Err
　　Range("A9").Value = CSV全データ行数
　　Range("B9").Value = Format(STime - Now(), "hh:mm:ss")
　　MsgBox Format(STime - Now(), "hh:mm:ss") & vbLf & CSV全データ行数
End Sub

【参照設定】　Microsoft Scripting Runtime　のチェック必要

Sub FSO仕様()
　　Dim Fso As New Scripting.FileSystemObject
　　Dim オープンファイル As String
　　オープンファイル = Application.GetOpenFilename("Excelファイル (*.csv;*.txt), *.csv;*.txt")
　　If オープンファイル = "False" Then
　　　 End
　　End If
　　ST = Now()
　　With Fso.OpenTextFile(Filename:=オープンファイル, IOMode:=ForReading)
　　　　Do Until .AtEndOfLine
　　　　　 .SkipLine
　　　　Loop
　　　　FSC = .Line - 1
　　End With
　　Range("A12").Value = FSC
　　Range("B12").Value = Format(ST - Now(), "hh:mm:ss")
　　MsgBox Format(ST - Now(), "hh:mm:ss") & vbLf & CSV全データ行数
End Sub

・ツリー全体表示

【78】あるセル範囲の左上のセルと右下のセルアド...

Jaka - 04/10/19(火) 11:18 -


	引用なし

	パスワード

過去ログ
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=4519;id=excel
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=6611;id=excel
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=18971;id=excel

過去ログをまとめてみると

With Selection
　　 MsgBox "左上アドレス " & .Address & vbLf & _
　　　　　　"左上行 " & .Row & vbLf & _
　　　　　　"左上列 " & .Column & vbLf & _
　　　　　　"右下行 " & .Row + .Rows.Count - 1 & vbLf & _
　　　　　　"右下列 " & .Column + .Columns.Count - 1 & vbLf & _
　　　　　　 vbLf & _
　　　　　　 vbLf & _
　　　　　　"左上アドレス " & .Cells(1).Address(0, 0) & vbLf & _
　　　　　　"範囲上の行番 " & .Cells(1).Row & vbLf & _
　　　　　　"範囲左の列番 " & .Cells(1).Column & vbLf & _
　　　　　　 vbLf & _
　　　　　　"右下アドレス " & .Cells(.Count).Address(0, 0) & vbLf & _
　　　　　　"範囲下の行番 " & .Cells(.Count).Row & vbLf & _
　　　　　　"範囲右の列番 " & .Cells(.Count).Column
End With

ついでにある範囲におけるCellsの添え字について
えっと、１度下記コードを実行させてみてください。
少しは、基本的なことがわかるかと思います。
取り合えず範囲として、マクロでセル範囲を選択させて、選択してあるセル範囲を処理対象としてあります。

Sub Cellsの添え字の位置()
　　Dim cel As Range, i As Long
　　Range("B2:F11").Select
　　
　　i = 0
　　For Each cel In Selection
　　　　i = i + 1
　　　　cel.Value = Format(i, "00") & " - " & Selection.Cells(i).Address(0, 0)
　　Next
　　
　　'選択されているセルの数分のセル、つまり最後のセル
　　MsgBox Selection.Cells(Selection.Count).Address(0, 0)
　　'上は、こういう意味。2～11で10、B～Fで5
　　MsgBox Selection.Cells(10 * 5).Address(0, 0)
End Sub

Sub 選択範囲に縦の連番を()
　　Dim cel As Range, i As Long, ii As Long
　　Range("A15:F29").Select
　　
　　For i = 1 To Selection.Columns.Count
　　　　For ii = 1 To Selection.Rows.Count
　　　　　　Selection.Cells(ii, i).Value = _
　　　　　　　　　　　i * Selection.Rows.Count - Selection.Rows.Count + ii
　　　　Next
　　Next
End Sub

私の能力では、これ以上うまくまとめられませんでした.....。

・ツリー全体表示

【77】Re:FilePathを列挙するサンプル(API)

ちゃっぴ - 04/9/14(火) 1:50 -


	引用なし

	パスワード

Win32API FindFirstFile(W)を使ったサンプルです。
【EnumFilePathList4】をコールしてお使いください。

Const INVALID_HANDLE_VALUE　　　As Long = (-1)　　　　　　　'無効なFile Handle値

'ファイル属性
Const FILE_ATTRIBUTE_DIRECTORY　As Long = &H10　　　　　　　'フォルダ

Const MAX_PATH　　　　　　　　　As Long = 260&　　　　　　　'パスの最大長
Const conUnicodeMaxPath　　　　 As Long = MAX_PATH * 2 - 1　'Unicodeでのパス最大長

'WIN32_FIND_DATA構造体(ディレクトリエントリ(ファイル情報))
Private Type WIN32_FIND_DATA
　　dwFileAttributes　　　　　　As Long　　　　　　 'ファイル属性
　　ftCreationTime　　　　　　　As Currency　　　　 '作成日時
　　ftLastAccessTime　　　　　　As Currency　　　　 '最終アクセス日時
　　ftLastWriteTime　　　　　　 As Currency　　　　 '最終更新日時
　　nFileSizeHigh　　　　　　　 As Long　　　　　　 'ファイルサイズの上位32bit値
　　nFileSizeLow　　　　　　　　As Long　　　　　　 'ファイルサイズの下位32bit値
　　dwReserved0　　　　　　　　 As Long　　　　　　 '予約(現状なし)
　　dwReserved1　　　　　　　　 As Long　　　　　　 '予約(現状なし)
　　cFileName(MAX_PATH * 2 - 1) As Byte　　　　　　 'ロングファイル名
　　cAlternate(14 * 2 - 1)　　　As Byte　　　　　　 'ショートファイル名(8+3文字)
End Type

'-------------------------------------------------------------------------------------------
'[FindFirstFile]　　　　　　　　　　　　　　　　文字列と一致するファイルを検索する
'　　　　　　　　　　　　　　　　　　　　　　　 (Unicode版)
'
'戻り値　　　　　　　　　　　　　　　　　　　　成功：検索ハンドル(Long)
'　　　　　　　　　　　　　　　　　　　　　　　失敗：INVALID_HANDLE_VALUE(-1)
'
'引数　　　　　　　 lpFileName　　　　　　　　　パス名文字列のポインタ(Long)
'　　　　　　　　　 lpFindFileData　　　　　　　検索結果([WIN32_FIND_DATA]構造体)
'-------------------------------------------------------------------------------------------
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" _
　　　　　　　　　　　　　　　　(ByVal lpFileName As Long, _
　　　　　　　　　　　　　　　　 lpFindFileData As WIN32_FIND_DATA) As Long

'-------------------------------------------------------------------------------------------
'[FindNextFile]　　　　　　　　　　　　　　　　 [FindFirstFile]から継続してファイルを検索する
'　　　　　　　　　　　　　　　　　　　　　　　 (Unicode版)
'
'戻り値　　　　　　　　　　　　　　　　　　　　成功：検索ハンドル(Long)
'　　　　　　　　　　　　　　　　　　　　　　　失敗：0
'
'引数　　　　　　　 lpFileName　　　　　　　　　パス名文字列のポインタ(Long)
'　　　　　　　　　 lpFindFileData　　　　　　　検索結果([WIN32_FIND_DATA]構造体)
'-------------------------------------------------------------------------------------------
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" _
　　　　　　　　　　　　　　　　(ByVal hFindFile As Long, _
　　　　　　　　　　　　　　　　 lpFindFileData As WIN32_FIND_DATA) As Long
　　　　　　　　　　　　　　　　
'-------------------------------------------------------------------------------------------
'[FindClose]　　　　　　　　　　　　　　　　　　[FindFirstFile]ハンドルをクローズする
'
'戻り値　　　　　　　　　　　　　　　　　　　　 0：失敗, 0以外：成功
'
'引数　　　　　　　 hFindFile　　　　　　　　　対象検索ハンドル(Long)
'-------------------------------------------------------------------------------------------
Private Declare Function FindClose Lib "kernel32" _
　　　　　　　　　　　　　　　　(ByVal hFindFile As Long) As Long

'*******************************************************************************************
'[EnumFilePathList4]
'
'引数　　　　　　　 strSearchPath　　　　　　　検索対象パス名(String)
'　　　　　　　　　 strSearchBaseName　　　　　検索対象ファイル名(String)
'　　　　　　　　　 strSearchExtention　　　　　検索対象拡張子(String)
'*******************************************************************************************
Sub EnumFilePathList4(ByVal strSearchPath As String, _
　　　　　　　　　　　Optional ByVal strSearchBaseName As String = "*", _
　　　　　　　　　　　Optional ByVal strSearchExtention As String = "*")

　　Dim udtWin32FindData　　　　As WIN32_FIND_DATA　　　'[WIN32_FIND_DATA]構造体(検索結果)
　　Dim lngFindFileHandle　　　 As Long　　　　　　　　 '[FindFirstFile]のハンドル
　　Dim strFindFileName　　　　 As String　　　　　　　 '検索結果ファイル名
　　Dim lngResultCode　　　　　 As Long　　　　　　　　 'APIのエラーコード
　　
　　'検索フルパス名を生成
　　strSeachFullPath = IIf(strSearchPath Like "\\*", "\\?\UNC" & _
　　　　Mid$(strSearchPath, 2), "\\?\" & strSearchPath) _
　　　　& "\" & strSearchBaseName & "." & strSearchExtention

　　'文字列に一致するファイルを検索し、WIN32_FIND_DATA構造体に値を代入
　　lngFindFileHandle = FindFirstFile(StrPtr(strSeachFullPath), udtWin32FindData)

　　'検索結果ファイルハンドルが無効な場合終了
　　If lngFindFileHandle <> INVALID_HANDLE_VALUE Then
　　　　Do
　　　　　　'ファイル名からNull文字を削除し格納
　　　　　　strFindFileName = CStr(udtWin32FindData.cFileName)
　　　　　　strFindFileName = Left$(strFindFileName, InStr(strFindFileName, vbNullChar) - 1)
　　　　　　
　　　　　　'ファイル名が現在のフォルダ"."及び上位フォルダ".."でない場合
　　　　　　If strFindFileName <> "." And strFindFileName <> ".." Then
　　　　　　　　'ファイルの属性がディレクトリの場合
　　　　　　　　If udtWin32FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
　　　　　　　　　　'サブフォルダを検索(再帰呼び出し)
　　　　　　　　　　Call EnumFilePathList4(strSearchPath & "\" & strFindFileName, _
　　　　　　　　　　　　　　　　　　　　strSearchBaseName, strSearchExtention)
　　　　　　　　Else
　　　　　　　　　　Debug.Print strSearchPath & "\" & strFindFileName
　　　　　　　　End If
　　　　　　End If
　　　　' 継続してファイルを検索
　　　　Loop While FindNextFile(lngFindFileHandle, udtWin32FindData)
　　End If
　　
　　'ファイルハンドルをクローズ
　　lngResultCode = FindClose(lngFindFileHandle)
End Sub

Unicode版FindFirstFileを使用したサンプルです。
Unicode版なのでWindows2000以降限定です。

速度に関しては言うまでもありません。
これが使えこなせれば、いうことはないでしょう。

他にもDir関数、FileSearchオブジェクト等ファイル検索するものは
ありますが、問題があるため推奨しません。

・ツリー全体表示

【76】FilePathを列挙するサンプル(API)

ちゃっぴ - 04/9/14(火) 1:37 -


	引用なし

	パスワード

Win32API FindFirstFile(A)を使ったサンプルです。【EnumFilePathList3】をコールしてお使いください。 Const INVALID_HANDLE_VALUE　　　As Long = (-1)　　　　　　　'無効なFile Handle値 'ファイル属性 Const FILE_ATTRIBUTE_DIRECTORY　As Long = &H10　　　　　　　'フォルダ Const MAX_PATH　　　　　　　　　As Long = 260&　　　　　　　'パスの最大長 'WIN32_FIND_DATA構造体(ディレクトリエントリ(ファイル情報)) Private Type WIN32_FIND_DATA 　　dwFileAttributes　　As Long　　　　　　　　 'ファイル属性　　ftCreationTime　　　As Currency　　　　　　 '作成日時　　ftLastAccessTime　　As Currency　　　　　　 '最終アクセス日時　　ftLastWriteTime　　 As Currency　　　　　　 '最終更新日時　　nFileSizeHigh　　　 As Long　　　　　　　　 'ファイルサイズの上位32bit値　　nFileSizeLow　　　　As Long　　　　　　　　 'ファイルサイズの下位32bit値　　dwReserved0　　　　 As Long　　　　　　　　 '予約(現状なし) 　　dwReserved1　　　　 As Long　　　　　　　　 '予約(現状なし) 　　cFileName　　　　　 As String * MAX_PATH　　'ロングファイル名　　cAlternate　　　　　As String * 14　　　　　'ショートファイル名(8+3文字) End Type '------------------------------------------------------------------------------------------- '[FindFirstFile]　　　　　　　　　　　　　　　　文字列と一致するファイルを検索する ' '戻り値　　　　　　　　　　　　　　　　　　　　成功：検索ハンドル(Long) '　　　　　　　　　　　　　　　　　　　　　　　失敗：INVALID_HANDLE_VALUE(-1) ' '引数　　　　　　　 lpFileName　　　　　　　　　パス名文字列のポインタ(Long) '　　　　　　　　　 lpFindFileData　　　　　　　検索結果([WIN32_FIND_DATA]構造体) '------------------------------------------------------------------------------------------- Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" _ 　　　　　　　　　　　　　　　　(ByVal lpFileName As String, _ 　　　　　　　　　　　　　　　　 lpFindFileData As WIN32_FIND_DATA) As Long '------------------------------------------------------------------------------------------- '[FindNextFile]　　　　　　　　　　　　　　　　 [FindFirstFile]から継続してファイルを検索する '　　　　　　　　　　　　　　　　　　　　　　　 (Unicode版) ' '戻り値　　　　　　　　　　　　　　　　　　　　成功：検索ハンドル(Long) '　　　　　　　　　　　　　　　　　　　　　　　失敗：0 ' '引数　　　　　　　 lpFileName　　　　　　　　　パス名文字列のポインタ(Long) '　　　　　　　　　 lpFindFileData　　　　　　　検索結果([WIN32_FIND_DATA]構造体) '------------------------------------------------------------------------------------------- Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileW" _ 　　　　　　　　　　　　　　　　(ByVal hFindFile As Long, _ 　　　　　　　　　　　　　　　　 lpFindFileData As WIN32_FIND_DATA) As Long 　　　　　　　　　　　　　　　　 '------------------------------------------------------------------------------------------- '[FindClose]　　　　　　　　　　　　　　　　　　[FindFirstFile]ハンドルをクローズする ' '戻り値　　　　　　　　　　　　　　　　　　　　 0：失敗, 0以外：成功 ' '引数　　　　　　　 hFindFile　　　　　　　　　対象検索ハンドル(Long) '------------------------------------------------------------------------------------------- Private Declare Function FindClose Lib "kernel32" _ 　　　　　　　　　　　　　　　　(ByVal hFindFile As Long) As Long '******************************************************************************************* '[EnumFilePathList3] ' '引数　　　　　　　 strSearchPath　　　　　　　検索対象パス名(String) '　　　　　　　　　 strSearchBaseName　　　　　検索対象ファイル名(String) '　　　　　　　　　 strSearchExtention　　　　　検索対象拡張子(String) '******************************************************************************************* Sub EnumFilePathList3(ByVal strSearchPath As String, _ 　　　　　　　　　　　Optional ByVal strSearchBaseName As String = "*", _ 　　　　　　　　　　　Optional ByVal strSearchExtention As String = "*") 　　Dim udtWin32FindData　　　　As WIN32_FIND_DATA　　　'[WIN32_FIND_DATA]構造体(検索結果) 　　Dim lngFindFileHandle　　　 As Long　　　　　　　　 '[FindFirstFile]のハンドル　　Dim strFindFileName　　　　 As String　　　　　　　 '検索結果ファイル名　　Dim lngResultCode　　　　　 As Long　　　　　　　　 'APIのエラーコード　　　　'検索フルパス名を生成　　strSeachFullPath = strSearchPath _ 　　　　& "\" & strSearchBaseName & "." & strSearchExtention 　　'文字列に一致するファイルを検索し、WIN32_FIND_DATA構造体に値を代入　　lngFindFileHandle = FindFirstFile(strSeachFullPath, udtWin32FindData) 　　'検索結果ファイルハンドルが無効な場合終了　　If lngFindFileHandle <> INVALID_HANDLE_VALUE Then 　　　　Do 　　　　　　'ファイル名からNull文字を削除し格納　　　　　　strFindFileName = udtWin32FindData.cFileName 　　　　　　strFindFileName = Left$(strFindFileName, InStr(strFindFileName, vbNullChar) - 1) 　　　　　　　　　　　　'ファイル名が現在のフォルダ"."及び上位フォルダ".."でない場合　　　　　　If strFindFileName <> "." And strFindFileName <> ".." Then 　　　　　　　　'ファイルの属性がディレクトリの場合　　　　　　　　If udtWin32FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then 　　　　　　　　　　'サブフォルダを検索(再帰呼び出し) 　　　　　　　　　　Call EnumFilePathList4(strSearchPath & "\" & strFindFileName, _ 　　　　　　　　　　　　　　　　　　　　strSearchBaseName, strSearchExtention) 　　　　　　　　Else 　　　　　　　　　　Debug.Print strSearchPath & "\" & strFindFileName 　　　　　　　　End If 　　　　　　End If 　　　　' 継続してファイルを検索　　　　Loop Until FindNextFile(lngFindFileHandle, udtWin32FindData) = 0 　　End If 　　　　'ファイルハンドルをクローズ　　lngResultCode = FindClose(lngFindFileHandle) End Sub 難易度はかなり高めですが、速度は驚きです。 DIRコマンドと同じくファイル名にワイルドカードを使用して、フィルタリングすることが可能です。ただ、ANSI版ですので、パス名にUnicode拡張文字が使用されていた場合、エラーになります。 NT系のOSを使用している場合には、後述のFindFirstFile(W)を使用したほうがよいでしょう。

・ツリー全体表示

【75】Re:FilePathを列挙するサンプル

ちゃっぴ - 04/9/14(火) 0:03 -


	引用なし

	パスワード

【その２　コマンドプロンプトDIRコマンド Version】

【要参照】「Windows Scripting Host Object Model」

Sub EnumFilePathList()
　　Dim objWshShell　　 As wshShell
　　Dim objFSO　　　　　As FileSystemObject
　　Dim objRedirectFile As File
　　Dim objRedirectTXT　As TextStream
　　Dim strTargetPath　 As String　　　 '対象フォルダパス
　　Dim strRedirectPath As String　　　 '一時ファイルパス
　　Dim lngReturn　　　 As Long
　　Dim varFileList　　 As Variant
　　Dim varFilePath　　 As Variant
　　
　　Set objWshShell = New wshShell
　　Set objFSO = New FileSystemObject
　　
　　lngReturn = objWshShell.Run("CMD /C DIR """ & strTargetPath _
　　　　& """ /A-D /B /S > """ & strRedirectPath & """", 7, True)
　　Set objWshShell = Nothing

　　If lngReturn = 0 Then
　　　　Set objRedirectFile = objFSO.GetFile(strRedirectPath)
　　　　Set objRedirectTXT = objRedirectFile.OpenAsTextStream
　　　　
　　　　varFileList = Split(objRedirectTXT.ReadAll)
　　　　
　　　　For Each varFilePath In varFileList
　　　　　　Debug.Print varFilePath
　　　　Next varfilpath
　　　　
　　　　objRedirectTXT.Close
　　　　objRedirectFile.Delete
　　　　
　　　　Set objRedirectTXT = Nothing
　　　　Set objRedirectFile = Nothing
　　End If
　　Set objFSO = Nothing
End Sub

ファイルの入出力を介しますが、FSOよりも動作が速いのが魅力です。
また、サブフォルダの検索のOn/Offをオプション"/S"だけで
切り替えられるのも魅力です。

ただ、残念なことにOSに依存します。

・ツリー全体表示

【74】FilePathを列挙するサンプル

ちゃっぴ - 04/9/13(月) 23:57 -


	引用なし

	パスワード

Jakaさんが一人でがんばっているみたいなので･･･
私も一点。

FAQであるFilePathを列挙するサンプルです。

【その１　FSO Version】

【要参照】「Microsoft Scripting Runtime」

'呼び出し用
Sub CallFilePathList1()
　　Dim objFSO　　　　　As FileSystemObject
　　Dim strTargetPath　 As String　　　　　 '対象フォルダパス
　　
　　Set objFSO = New FileSystemObject
　　
　　Call EnumFilePathList1(objFSO.GetFolder(strTargetPath))
End Sub

'本体
Sub EnumFilePathList1(objFolder As Folder)
　　Dim objTargetFile　 As File
　　Dim objSubFolder　　 As Folder
　　
　　'ファイル名を列挙
　　For Each objTargetFile In objFolder.Files
　　　　Debug.Print objTargetFile.Path
　　Next objTargetFile
　　
　　'サブフォルダを検索
　　For Each objSubFolder In objFolder.SubFolders
　　　　Call EnumFilePathList1(objSubFolder)
　　Next objSubFolder
End Sub

非常にシンプルで不具合も少ないのですが、
速度が非常に遅いのがネックです。
(初心者にもっともお勧め･･･)

・ツリー全体表示

【73】Ｖ３にもあったんですね！

Jaka - 04/9/2(木) 12:26 -


	引用なし

	パスワード

りんさんが先にやってました。

http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=ntr;tree=12176;id=Excel
http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=ntr;tree=31;id=FAQ

・ツリー全体表示

【72】Re:図形描画、Shapeの方のテキストボックス...

ichinose - 04/8/31(火) 8:08 -


	引用なし

	パスワード

▼Jaka さん：
こんにちは。

Jakaさん、すごいですね！！目安箱での活躍・・・。

私も一つだけ投稿・・・。

「図形描画のShapeの方のテキストボックスにセルの内容を反映させる方法」

'==================================
Sub samp()
　 With Range("a2")
　　　.Offset(-1, 0).Value = "反映"
　　　Set txt = ActiveSheet.TextBoxes.Add(.Left, .Top, .Width, .Height)
　　　txt.Formula = "=" & .Offset(-1, 0).Address
　　　End With
End Sub

上記のコードは、アクティブシートのセルＡ２のサイズにテキストボックスを作成し、
セルＡ１の内容をテキストボックスに反映させるコードです。

このコードの実行後に、セルＡ１の変更でテキストボックスの内容も変更されます。
マクロを使用しなくても手動操作でも可能です。

・ツリー全体表示

【71】Re:フォルダの選択

Jaka - 04/8/30(月) 16:33 -


	引用なし

	パスワード

おお～、いつのまにかこんなにたくさん。
どこにつけて良いのか解らなかったんでここに。
んで、

>obj.Items.Item.Pathだと「デスクトップフォルダ」が選択できなくなるので
？？？デスクトップはＣ開いてＸＸ開いて・・・開いてで、開けるじゃん。
と、思っていたら、てっぺんのデスクトップの事だったんですね。
ここって触れるのね。
知らんかった。

私のだとてっぺんのデスクトップを選んだら、エラーになっちゃいますね！
今度からは、.SpecialFolders("DeskTop")を使わせてもらいます。
ありがとうございます。
それと、今のところフォローがここだけしかないんですけど、他のは....。

・ツリー全体表示

【70】フォルダ選択<FileDialog使用>

BOTTA - 04/8/23(月) 19:32 -


	引用なし

	パスワード

'<FileDialog使用>
'Excel2002以降、FileDialogオブジェクトが使えるようになった
'引数「fileDialogType」にmsoFileDialogFolderPickerを指定
'従って、Excel2002以降限定
'個人的にはDialogの形がFile選択と同じであまり好きではない
Sub f選択03()
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　If .Show = -1 Then
　　　　　　MsgBox .SelectedItems(1), 64, "選択されたフォルダ"
　　　　End If
　　End With
End Sub

・ツリー全体表示

【69】フォルダ選択<Shell使用>

BOTTA - 04/8/23(月) 19:32 -


	引用なし

	パスワード

'<Shell使用>Jakaさんコードに追加
'obj.Items.Item.Pathだと「デスクトップフォルダ」が選択できなくなるので
'「デスクトップフォルダ」選択時の処理を追加
Sub f選択02()
　　Dim obj As Object
　　Dim tmpF As String
　　Dim SelectedF As String
　　Set obj = CreateObject("Shell.Application"). _
　　　　browseforfolder(0&, "フォルダを選択してネ", &H1, &H0)
　　If Not obj Is Nothing Then
　　　　If Not obj.ParentFolder Is Nothing Then
　　　　　　tmpF = obj.Items.Item.Path
　　　　Else
　　　　　　Dim objDskTop As Object
　　　　　　Set objDskTop = CreateObject("WScript.Shell")
　　　　　　tmpF = objDskTop.SpecialFolders("DeskTop")
　　　　　　Set objDskTop = Nothing
　　　　End If
　　　　If tmpF = "" Then MsgBox "選択不可!!", 16: GoTo HdlExit
　　　　SelectedF = tmpF
　　　　MsgBox SelectedF, 64, "選択されたフォルダ"
　　End If
HdlExit:
　　Set obj = Nothing
End Sub
'補足
'>IE4.0以上が、インストールされていることが前提
'ですが､もっと詳しくは､
'IE4.0以上で、SHELL32.DLLのバージョンが4.71以降でないとエラーになります。
'(IE4.0でも、シェル統合インストールしていない場合はSHELL32.DLLのバージョンは
'4.71未満のままだそうです。＞by JuJuさん)

・ツリー全体表示

【68】フォルダ選択<API使用>

BOTTA - 04/8/23(月) 19:31 -


	引用なし

	パスワード

Jakaさん、どもっ。
「フォルダの選択」には悩んだことがありまして、補足させて頂きます。
'********************************************************************************
'<API使用>
'参考　 http://support.microsoft.com/default.aspx?scid=kb;ja;179497
'APIを使ったもの、これが一番汎用性があるみたい
Option Explicit
Declare Function SHBrowseForFolder Lib "shell32.dll" _
　　Alias "SHBrowseForFolderA" _
　　(lpbi As BrowseInfo) As Long

Declare Function SHGetPathFromIDList Lib "shell32.dll" _
　　Alias "SHGetPathFromIDListA" _
　　(ByVal pidl As Long, _
　　ByVal pszPath As String) As Long

Declare Sub CoTaskMemFree Lib "OLE32.dll" (ByVal pv As Long)

Type BrowseInfo
　　hWndOwner As Long　　　　'親ウィンドウハンドル
　　pIDLRoot As Long　　　　 'ルートフォルダ(デスクトップは &H0)
　　pszDisplayName As String '選択したフォルダ
　　lpszTitle As String　　　'タイトル
　　ulFlags As Long　　　　　'動作方法の指定(フォルダ選択は &H1)
　　lpfnCallback As Long
　　lParam As Long
　　iImage As Long
End Type

Sub f選択01()
　　Dim B_Info As BrowseInfo
　　Dim lpIDList As Long '戻り値
　　Dim SelectedF As String

　　With B_Info
　　　　.pIDLRoot = &H0 'デスクトップをルートに設定
　　　　.lpszTitle = "フォルダを選択してネ"
　　　　.ulFlags = &H1 'フォルダ選択限定
　　End With

　　lpIDList = SHBrowseForFolder(B_Info)　　　　　'「フォルダ選択」ダイアログを表示
　　SelectedF = String$(256, vbNullChar)　　　　　'受取領域確保
　　Call SHGetPathFromIDList(lpIDList, SelectedF) 'フォルダパス取得
　　CoTaskMemFree lpIDList　　　　　　　　　　　　'メモリ解放

　　If lpIDList <> 0 Then
　　　　If Left(SelectedF, 1) = vbNullChar Then MsgBox "選択不可!!", 16: Exit Sub
　　　　SelectedF = Left(SelectedF, InStr(SelectedF, vbNullChar) - 1)
　　　　MsgBox SelectedF, 64, "選択されたフォルダ"
　　End If
End Sub

・ツリー全体表示

【67】エクセルIF関数　７つまでのネストを有効利...

Jaka - 04/8/17(火) 15:34 -


	引用なし

	パスワード

ネストを有効利用するコツは、半分個づつしていけば2^7で、128個の分岐ができる？

例えば、0～100までだったら、0～50、50～100に分けて
0～50を0～25、26～50
50～100を50～75、76～100に分けると言った具合に。
orやandで、分けても良いです。

とはいっても、そんなにうまい具合にいくとは限りませんけど...。
A列に入った点数を５点刻みに評価する場合。

　　 A　　 B
1　 100　100点
2　 99　 95～99
3　 94　 90～94
4　 89　 85～89
5　 80　 80～84
6　 75　 75～79
7　 70　 70～74
8　 65　 65～69
9　 60　 60～64
10　55　 55～59
11　51　 50～54
12　45　 45～49
13　40　 40～44
14　38　 35～39
15　34　 30～34
16　25　 25～29
17　20　 20～24
18　15　 15～19
19　10　 10～14
20　 5　 5～9
21　 4　 1～4
22　 0　 0点

B1に下記関数を入れフィルドラッグ。
尚、半角英数字を改行無しで、１行にづらづら書くと「アップできません」と
　　跳ねられるので、ほんとに適当な位置で改行しました。

=IF(A1>=50,IF(A1>=75,IF(A1>=85,IF(A1>=95,IF(A1=100,"100点","95～99"),
IF(A1>=90,"90～94","85～89")),IF(A1>=80,"80～84","75～79")),IF(A1>=65,
IF(A1>=70,"70～74","65～69"),IF(A1>=55,IF(A1>=60,"60～64",IF(A1>=55,
"55～59","50～54")),"50～54"))),IF(A1>=35,IF(A1>=40,IF(A1>=45,"45～49"
,"40～44"),"35～39"),IF(A1>=30,"30～34",IF(A1>=15,IF(A1>=20,IF(A1>=25,
"25～29","20～24"),"15～19"),IF(A1>=5,IF(A1>=10,"10～14","5～9"),
IF(A1>0,"1～4","0点"))))))

別シートに評価表など作って、VLOOKUPやINDEXを使ったほうが簡単かも。

・ツリー全体表示

【66】参考にする方への訂正。

Jaka - 04/8/17(火) 15:27 -


	引用なし

	パスワード

今ごろだけど、正確さを考えると、余り分も計算に入れないとダメでしたね！
実行速度の遅さにとらわれていたもんで....。
　　
>　　Cnt = 行数範囲 \ (選択行数 + 空き行) - 1
>　　MsgBox "選択する行数は、" & Cnt & "行になります。"
>　　STime = Now()

　　　↓

　　Cnt = 行数範囲 \ (選択行数 + 空き行) - 1
　　If 選択行数 <= 行数範囲 Mod (選択行数 + 空き行) Then
　　　 Cnt = Cnt + 1
　　End If
　　MsgBox "選択する行数は、" & Cnt & "行になります。"

・ツリー全体表示

┃ ┃一覧表示 ┃ ┃ ┃ ┃

11 / 14 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free