スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

Happy な・・・ お知らせ 


現在、サーバの障害により、サンプルファイルの入手は困難になっています
いつ復旧するのかわからないのですが、日を改めて、再度トライしてみてください

(~6/26、~7/3、~?? と復旧見込みが延びてきています)

緊急の場合は、連絡いただければ・・・

サンプルファイルがなくても、
記事での記述でそれなりに動くものはできると思ってはいますが・・・


復旧後、このエントリは削除します

【8/20】

サーバには接続できるようになったみたいですが、データが空に・・・
データが戻るのか問合わせ中です

【8/23】

データは戻らないようなので、転送し直してダウンロードできる様にしてみました
抜けがあったら、コメント頂ければと・・・
スポンサーサイト

2016/08/23

Category: このブログについて

TB: --  /  CM: 0

top △

Excel VBA をやってみた その16 


過去記事に 大量なデータはどうする やら Excel VBA をやってみた その6 があったと思います。
要は、CSV ファイルを対象に ADO 接続して、SQL で必要なものを抽出しようというもの・・・
(Excelシートを対象に・・・Excel VBA をやってみた その7 があったり・・・)

今回の対象CSVのフォーマットは以下の様な感じで・・・・
ID,日時(yyyy/m/d h:mm),備考1,備考2
0001,2015/03/25 10:25,AAAA,BBBB
0001,2015/03/25 12:01,CCCC,DDDD
0001,2015/03/25 17:30,EE,FFF
0002,2015/03/26 9:15,KK,LL
0002,2015/03/26 12:10,MMMM,NNN
0002,2015/03/26 14:54,OOOOO,PPP
0002,2015/03/26 22:01,QQ,RRRR
・・・

この中から、同一IDで、同一日の最小/最大部分のみを抽出
0001,2015/03/25 10:25,AAAA,BBBB
0001,2015/03/25 17:30,EE,FFF
0002,2015/03/26 9:15,KK,LL
0002,2015/03/26 22:01,QQ,RRRR
・・・

で、この結果を
・ID毎のBook もしくは ID毎のシートに・・・・

実現の仕方には色々あると思います。
・ExcelにCSVファイルを展開して Filter 等の操作しながら結果を求める
・Access に1度データを取り込んで結果を吐き出す
・今記事の様に、CSV自体はExcel展開せずに最終形のExcel環境で操作できるようにする

考える際、1番いやだったのが
・項目名部分に「日時(yyyy/m/d h:mm)」というものが存在する
・ID部分を文字列として扱いたい

そこで、冒頭での記事では使わなかった「schema.ini」を利用する事に・・・
CSVファイルと同じフォルダ内の「schema.ini」に以下の様に記述しておくと
[CSVファイル名]
ColNameHeader=True
CharacterSet=932
Format=CSVDelimited
Col1=ID Char Width 255
Col2=日時 Date
Col3=備考1 Char Width 255
Col4=備考2 Char Width 255

CSVファイル内の項目名部分を置換えつつ、データの型を指定する事が出来ます。
この場合、CSV内の項目名「日時(yyyy/m/d h:mm)」は「日時」として扱えるようになります。
この「schema.ini」を使った方法は、Excel だけでなく Access 環境でも使えます。

今回の処理対象は1つのCSVファイルだけなので、Access に取り込んでから・・・
これは、優先順は低いかな・・・
複数のCSVを取り込んでから総合的に・・・なら最優先かも・・・かも・・・
続きを読んでみようかな ---≫

2015/05/26

Category: サンプルかな

TB: --  /  CM: 0

top △

Excel VBA をやってみた その15 


もう広告表示になったのね
記事として遅れていた分を緊急に・・・という事で


副題:重複しないグループ分けについて

重複しないグループ分けについて に回答したもの+α のものになります。
内容的には、
12人、15人の人で、1グループ3人の組合せを作る。
この時、1回以上違う人と組む。
15人の場合、1番の人なら、2番~15番の人と1回以上組む
というもの。

回答した、Samp1 / Samp2 / Samp3 は、重複しない組み合わせを求めて
Samp2 はソコソコに、Samp3 は一応全部組んでみよう・・・というもの
基本的な考え方は、以下の図の様な感じ

kEnt212.jpg

で、15人の場合を求めた結果は、左:Samp1、中:Samp2、右:Samp3
Samp1 / Samp2 は、人同士の組み合わせを Dictionary で管理
Samp3 は、人数 x 人数 の配列で管理

kEnt212_1.jpg  kEnt212_2.jpg  kEnt212_3.jpg

Samp1 / Samp2 / Samp3 では、重複しないものを1度求める事をしていたため、
人数が多くなればなるほど遅くなっていくので、
どうせ重複しないと全部求められないので、人数 x 人数の配列を綺麗に埋めていけば・・・
埋める際、何個使った・・・は、配列で管理して・・・埋め方を考えれば良いんでしょう・・・
※ この埋める時のやり方は、現状力任せになっています

Samp4 は単に、求めたパターンを管理する方法を変えてみただけの確認用
確認用の処理は、重複しない組み合わせが基本ですが、前に戻って求め直す事はしない。

kEnt212_4.jpg

Samp5 は、1グループ3人に限定して、処理パターンを4つ
人数 x 人数 の配列は、右上半分だけ使用・・・というのは
1グループに、1-2-3 番を作ったとした場合、配列(1,2)、配列(1,3)、配列(2,3) 部分を更新
この配列を更新して、使っていない部分がなくなるまで処理を続ける・・・・

処理1:配列(1,2) ~ (1,人数)、(2,3) ~ (2,人数) と探す
  使っていないものがあったら、その位置を確定して
  例えば、(x,y) が使っていなければ、残りの1つ z を
  z < x なら (z,x)、z < y なら (z,y)
  z > x なら (x,z)、z > y なら (y,z)
  この値を加算して1番小さかった z を残りの1つとして確定
処理2:探す順は処理1と同じだが、
  配列(1,2) ~ (1,人数) で使っていなものを探して、使っていないもの同士も使っていないものを優先
  例えば、(1,5)、(1,7)、(1,9)、(1,10)、(1,12) が使っていなかった場合
  (5,7)(5,9)(5,10)(5,12)(7,9)(7,10)(7,12)(9,10)(9,12)(10,12) の順で使っていないものを探す
処理3:配列(1,人数) ~ (人数-1,人数)、(1,人数-1) ~ (人数-2,人数-1) と探す
  残りの1つ z は同じようにして
処理4:処理2の処理3バージョン

パターンを求めていく中で、使える数字内で使っていないものが無かったら・・・
例えば、1 が使える場合
(1,2) ~ (1,人数) まで使える数字部分を眺めて、1番小さかったものを使う
1 以外に 6、9 が使えた場合、(1,6)、(1,9) の値の小さい 6 or 9 を選んでいく・・・

※ 残っていくもの同士の組合せについては、グループとして重複しない様にしているだけなので、
もっと数学的な選び方があると思いますが・・・力任せで・・・

以下は各処理で、左:15人、90人(中:31パターン目、右:結果)
「中:」の画像では、確定したパターンは赤もどきの色、確定候補が水色

処理1
kEnt212_5_1.jpg  kEnt212_5_1A.jpg  kEnt212_5_1B.jpg

処理2
kEnt212_5_2.jpg  kEnt212_5_2A.jpg  kEnt212_5_2B.jpg

処理3
kEnt212_5_3.jpg  kEnt212_5_3A.jpg  kEnt212_5_3B.jpg

処理4
kEnt212_5_40.jpg  kEnt212_5_4A.jpg  kEnt212_5_4B.jpg
続きを読んでみようかな ---≫

2015/04/11

Category: やってみる

TB: --  /  CM: 0

top △

貸出台帳もどきの雰囲気? 


1.貸し出しの時に、使用者名・所属・TEL・借用日・返却予定日を記入し、借りる備品をリストから選択(この時複数選択する)

2.返却の時に、使用者名を選択すると借用中リストを表示し、返却した備品を一つずつ選択、または一括返却ボタンで一括返却する。

3.貸し出し・返却の履歴を残す。
※備品の破損・紛失の際に、借用者の履歴が分かるようにしたい。

このようなQAを見かけました。
初心者という事なんですが、やりたいものを作る・・・・初心者云々は関係ないように思います。

そこで、1.、2. だけを雰囲気作ってみた。
ただ、、やりたいものと同じなのかはわからないけど・・・

メインとなるフォームは「F1」単票フォームに、サブフォーム2つ組み込み
サブフォームは横に配置して、
左側:貸出中の一覧表示
右側:貸出受付みたいなもの

kEnt211_7.jpg

起動して、顧客を選択していない状態では、左側に貸出中の一覧を表示

kEnt211_5.jpg

顧客を選択すると、左側には選択した顧客に絞った貸出中一覧表示に

kEnt211_6.jpg

返却チェックを入れると「返却」ボタンが表示
返却するのなら、そのままボタンをクリック
新規に貸し出すものがあるのなら、物を選んで「貸出」ボタンクリック
「貸出」ボタンをクリックするまでは、仮押さえっていうイメージで・・・
以下は新規に登録する時の画像になりますが、
左:顧客を選択して、中:貸出するものを選んで、右:「貸出」ボタンクリック後

kEnt211_3.jpg  kEnt211_4.jpg  kEnt211_5.jpg

中の画像で、貸出中のもの・仮押さえのものは選択一覧には表示されない様に・・・
(左画像内の一覧から、仮押さえしたもの以外が表示されていると思います)

選択する部分は、コンボボックスになっています。
顧客選択・受付部分の品物選択の2つは、部分一致で絞り込み表示する様に・・・

左側:「務」を入れてみる 右側:「D」を入れてみる

kEnt211_8.jpg  kEnt211_9.jpg

メイン・サブフォームの連動は、リンク親/子フィールドは使わないで連携してみました。
というのは、顧客を選び直した・・・このタイミングで中の処理を切り替えたかったので・・・

なお、動きを実現するにあたって、hatena さんの記事で紹介されたものをアレンジして使ってます。
非連結のチェックボックスでレコードを選択する とか コンボボックスのリストを入力値で制限する とか・・・
続きを読んでみようかな ---≫

2015/03/11

Category: サンプルかな

TB: --  /  CM: 0

top △

CSVの自力解釈 


CSV 云々に関しては、過去記事「テキストファイル(CSV等)の項目変換」とか・・・
処理内容については細かく記述してませんでしたね。

まぁ、あのツールもいろんなパターンを処理しきれているわけでもないので・・・
ソコソコ使ってみて、使えるようなら使うという事で・・・

今回、関数として作成したので、
・そのままでも・・・
・部分的にでも・・・

1行だけでも、複数行でもソコソコ処理できているんじゃないかな・・・と思ってみたり
内部の処理パターンは2種で
・Split で分けながら " " で囲まれた中での改行判別・・・とか
・InStr を多用して、文字列を切り出していく・・・とか

Private Function PartsInLines(sBuf As String, Optional sSep As String = ",") As Variant

っていう主処理部分に皮をかぶせて
Public Function PartsInLinesCSV(sBuf As String) As Variant
  PartsInLinesCSV = PartsInLines(sBuf)
End Function

Public Function PartsInLinesTAB(sBuf As String) As Variant
  PartsInLinesTAB = PartsInLines(sBuf, vbTab)
End Function

Public Function PartsInLinesSPACE(sBuf As String) As Variant
  PartsInLinesSPACE = PartsInLines(sBuf, " ")
End Function

これの呼び出し方は、(以下は Excel での例ですが、Access でも・・・)
(ソコソコの大きさのファイルなら以下で大丈夫だと思います)
Public Sub testReadGet()
  Dim ffn As Integer
  Dim v As Variant
  Dim btBuf() As Byte, sBuf As String
  Dim i As Long, j As Long

  ffn = FreeFile()
  Open ThisWorkbook.Path & "\ファイル名.csv" For Binary As #ffn
  ReDim btBuf(1 To LOF(ffn))
  Get #ffn, , btBuf
  Close #ffn
  sBuf = StrConv(btBuf, vbUnicode)

  v = PartsInLinesCSV(sBuf)
  Debug.Print sBuf
  For i = LBound(v) To UBound(v)
    For j = LBound(v(i)) To UBound(v(i))
      Debug.Print i; "."; j; " > "; v(i)(j)
    Next
  Next
End Sub

ファイルがかなり大きくて、1行ずつの処理が良いなら
Public Sub testReadLine()
  Dim ffn As Integer
  Dim v As Variant
  Dim sBuf As String
  Dim i As Long, j As Long

  ffn = FreeFile()
  Open ThisWorkbook.Path & "\ファイル名.csv" For Input As #ffn
  While (Not EOF(ffn))
    Line Input #ffn, sBuf

    v = PartsInLinesCSV(sBuf)
    Debug.Print sBuf
    For i = LBound(v) To UBound(v)
      For j = LBound(v(i)) To UBound(v(i))
        Debug.Print i; "."; j; " > "; v(i)(j)
      Next
    Next
  Wend
  Close #ffn
End Sub

    For i = LBound(v) To UBound(v)
部分は、1行分しか解釈させていないので v(0) 固定でも・・・
でも、でも・・・解釈できない場合は、空配列を返すので、固定はまずいかも・・・
戻り値は、Variant の配列で
・UBound(v)+1 で何行ありますよ( LBound(v) は 0 なんだけど一応・・・・)
・で、v(i)(0 ~ xx) がその行で切り出した項目(文字列 String で返します)
ってなものになってます。

仕様という程のものでは・・・・以下を処理します。
区切りを , とした場合

・文字列の囲みは、 " " および ' ' を自動認識
 また、囲みの文字が抜き出した文字列内にあったら、2個→1個に
"A,BC""DEF",'a,bc''def',1234 とか "A,BC""DEF" , 'a,bc''def' , 1234

(0)A,BC"DEF
(1)a,bc'def
(2)1234

・文字列の囲み以外の " および ' はそのまま
"A,B''C""DEF",'a,b""c''def',1234 とか "A,B''C""DEF" , 'a,b""c''def' , 1234

(0)A,B''C"DEF
(1)a,b""c'def
(2)1234

・囲み文字内の改行は項目内の文字列に入れる
・各行の項目数が違っていても合わせる事はしない
・項目は全て文字列として返す
続きを読んでみようかな ---≫

2015/03/06

Category: 関数を作ってみる

TB: --  /  CM: 0

top △

Excelのハイパーリンク情報をインポートする 


ハイパーリンクについては、過去記事「ハイパーリンクって、、、セキュリティは」でも扱っていました。
私自体はハイパーリンク型は使わないのですが、データを取り込む元の状態を維持したいとかなると・・・
特に、Excel でハイパーリンク設定されているものをインポートしつつ、ハイパーリンクとして機能させるには・・・
ということで、やってみたものになります。
ま、きっかけは回答した事・・・・ですけど。

今回の添付ファイルには、Excelファイル「kEnt209.xls」とアクセスファイルの2つが入っています。
Excel ファイルには2つのシートがあって、
「Sheet1」が取り込む元となるもの(図左)
「Sheet2」は「Sheet1」の B4 からリンク( Sheet2!A1 )(図右)

kEnt209_Excel_1.jpg  kEnt209_Excel_2.jpg

この「Sheet2」はブログの記事一覧にもなっているので・・・
C列はハイパーリンクとしていませんが、1度編集状態にしてから Enter すればリンクが張られるようなので、簡単に記事に飛べると思います。

確認用フォームは以下

kEnt209_1.jpg

確認内容は、
1)回答したもの Samp1
2)DoCmd.TransferSpreadsheet を使った Samp2
3)Excel ファイル内でリンクしていたものを参照できるように Samp3
4)3)のやり方をチョッと変更してみたのが Samp4

これをやってみてわかった事は、
・DoCmd.TransferSpreadsheet では、表示されている文字列だけ
 (ハイパーリンクとしては機能しない)
・Excel の空白( Empty値 )をレコードセットでフィールドに代入すると Null になる
続きを読んでみようかな ---≫

2015/02/26

Category: サンプルかな

TB: --  /  CM: 0

top △

ブログ内表示がまたおかしくなった 


いつ頃からなのかはっきりしませんが、さっき気付いて・・・

ブログ記事内の表示が・・・
http://kikutips.blog13.fc2.com/blog-entry-138.html

ブログ記事内の表示が・・・その2
http://kikutips.blog13.fc2.com/blog-entry-139.html

の時と現象は同じ・・・・ではなく、
以前は FC2 にログインしていた時には正常に見えていましたが、今回は表示変わらず。

VBA 等を記述している、黒背景がチョッと膨らむ感じがなくなり、左端が切れ
また、テーブル内容も左寄り

テンプレート等は全然いじっていないし・・・


問い合わせてみよう

【追記】2/8
現在はチャンと見えていますが、ここに至るまでの経過を報告しておきます。

1/26 17:34 mail受信
 対処 : 私のテンプレートの修正(何を修正したかは不明)
 22:20 頃に採取した画面3種
(左:チョッと膨れて表示される部分がそのまま、中・右:テーブル内の表示が常に中央)

kEnt208_1A.jpg  kEnt208_1B.jpg  kEnt208_1C.jpg

1/27 15:07 mail受信
 対処 : Internet Explorer7をエミュレートするようにテンプレートを修正
     (メタタグ1行の追加)
 21:00 頃に採取した画面3種(上記部分と同じ所)

kEnt208_2A.jpg  kEnt208_2B.jpg  kEnt208_2C.jpg

これで、私の IE では意図した通りに表示されるようになりました。

他のブラウザで意図した通りになっていないとか、文字が切れているとか・・・
そのような事があれば、コメントでも頂けたらと思います。
膨れて表示する部分とか考えなおしてみたいと思います。

2015/01/26

Category: このブログについて

TB: --  /  CM: 0

top △

Excel VBA をやってみた その14 


何故だろう・・・ 質問者さんが質問を削除した。
他回答者さんも失礼な振る舞いをしていたとも思えない。
せっかくなので、ここで紹介・解説してみる

質問の内容は、

Sheet1の列Aの1行目から列XA200行目まで
すべての各セルに 22,22,45 のようにカンマで区切られた塊が書かれている。
このセル同士をひとつずつ順番にA列の1行目のセルにかいてあるものを基準にして比較していき、
もし同じ内容のセルがあった場合は、例えば、A1 と B2 が同じだったら「A列1行目とB列2行目」と
A列の300行目から文字として書き起こしていきます。
基準にするセルを変えながら参照し、比較し同じものを探すコードを教えてください。

というものに、以下を初期回答したのですが・・・
(初期回答というのは、この後、性能向上版を提示する為に回答削除・回答し直ししてました)

以下でどうでしょう
10秒もあれば終わると思います。
(試したデータでは5秒くらいでしたが・・・(最終行:15078))

Public Sub Samp1()
  Dim dic As Object, dicW As Object
  Dim vA As Variant, v As Variant, vv As Variant
  Dim sS As String
  Dim i As Long, j As Long

  Application.ScreenUpdating = False
  Set dic = CreateObject("Scripting.Dictionary")
  Set dicW = CreateObject("Scripting.Dictionary")
  vA = Range("A1:XA200").Value
  For j = 1 To UBound(vA, 2)
    For i = 1 To UBound(vA)
      sS = dicW(vA(i, j))
      If (Len(sS) > 0) Then
        If (dic.Exists(vA(i, j))) Then
          sS = dic(vA(i, j))
        Else
          v = Split(sS, "_")
          v(2) = Split(Cells(1, Int(v(1))).Address, "$")(1)
          sS = Join(v, "_")
        End If
        dic(vA(i, j)) = sS & "," _
          & i & "_" & j & "_" & Split(Cells(1, j).Address, "$")(1)
      Else
        dicW(vA(i, j)) = i & "_" & j & "_"
      End If
    Next
  Next

  If (dic.Count > 0) Then
    i = 0
    With Range("A300")
      For Each vA In dic.Items
        v = Split(vA, ",")
        ReDim vv(UBound(v))
        For j = 0 To UBound(v)
          vv(j) = Split(v(j), "_")
        Next
        For j = 1 To UBound(vv)
          sS = vv(0)(2) & " 列 " & vv(0)(0) & " 行目と " _
            & vv(j)(2) & " 列 " & vv(j)(0) & " 行目"
          .Offset(i).Resize(, 3) = _
            Array(sS, vv(0)(0), vv(0)(1))
          i = i + 1
        Next
      Next
      With .Resize(i, 3)
        .Sort .Cells(3), xlAscending, .Cells(2), Header:=xlNo
        .Offset(, 1).Resize(, 2).ClearContents
      End With
    End With
  End If
  Set dic = Nothing
  Set dicW = Nothing
  Application.ScreenUpdating = True
End Sub


※ テスト用データは以下で作成していました

Public Sub test()
  Dim r As Range
  Dim sS As String
  Dim i As Long

  Randomize
  Application.ScreenUpdating = False
  For Each r In Range("A1:XA200")
    sS = ""
    For i = 1 To 3
      sS = sS & "," & Int(78 * Rnd()) + 22
    Next
    r = Mid(sS, 2)
  Next
  Columns.AutoFit
  Application.ScreenUpdating = True
End Sub


そんなにヘンテコな記述じゃないと思うのですが・・・
まぁ、コメントも入れていないので、以降解説していきます。

※ 後半には、質問者さんは何か・・・ Find を使った方法を求めていた??? みたいなので
Find を使った記述にも触れています。
続きを読んでみようかな ---≫

2015/01/01

Category: 解説か

TB: --  /  CM: 0

top △

Excel VBA をやってみた その13 


副題:長さの種類の組み合わせ

組合せ合計値の検索は、過去記事「Excel VBA をやってみた その11」とか・・・
そこから色々な記事に飛べますね

今回は、長さの種類の組み合わせ・・・ということで、

全長:5200mm の棒を効率よく切っていきたい
切る長さは 520mm / 580mm / 730mm / 980mm / 1030mm / 1240mm の6種類
端材は 50mm ・・・ (おそらくは、切りしろを加味した長さ?)
なので、各種類を加算して 5150mm に近いもののパターン求めたい

考え方として、
各種類が 5150mm で何本取れるか・・・で
520mm なら9本取れるので、520 / 520 / ・・・ / 520 の9つのデータに展開して・・・
他の種類についても、同様にデータ展開して・・・ 
組合せ合計値の検索を使って求める・・・ でも良いかもしれない・・・???

でも、せっかくなので・・・
各種類を何本使っているかの管理でやってみようか・・・

で、回答してみたのが以下です・・・
黄色い表示の部分・・・ これ、処理を見なおして修正しています(後述 Samp2 として)
現状のままでも、実害はないのですが・・・

参考程度で

以下を実行すると、添付図のような結果が表示されます。
上書きする場合は、2行2列余計にクリアしてから出力します。

Public Sub Samp1()
  Dim dic As Object
  Dim vA As Variant, v As Variant
  Dim iA() As Long
  Dim iClen As Long, iPos As Long
  Dim sS As String
  Dim i As Long, j As Long
  Const CMAXLEN As Long = 5200 ' 全長
  Const CREMLEN As Long = 50 ' 残す
  Const COKLEN As Long = 30 ' 許容差

  vA = Array(520, 580, 730, 980, 1030, 1240, CMAXLEN)
  ReDim iA(UBound(vA))
  Set dic = CreateObject("Scripting.Dictionary")

  iClen = CMAXLEN - CREMLEN
  iPos = 0
  Do While ((0 <= iPos) And (iPos <= UBound(vA)))
    If (iClen >= vA(iPos)) Then
      iClen = iClen - vA(iPos)
      iA(iPos) = iA(iPos) + 1
    ElseIf (iClen <= COKLEN) Then
      sS = iClen + CREMLEN
      For i = 0 To UBound(iA)
        sS = sS & ","
        If (iA(i) <> 0) Then sS = sS & iA(i)
      Next
      dic(dic.Count) = sS
      iClen = iClen + vA(iPos)
      iA(iPos) = iA(iPos) - 1
      iPos = iPos + 1
    Else
      Do While (iPos >= 0)
        If (iA(iPos) <> 0) Then
          iClen = iClen + vA(iPos)
          iA(iPos) = iA(iPos) - 1
          iPos = iPos + 1
          If (iClen >= vA(iPos)) Then Exit Do
        Else
          iPos = iPos - 1
        End If

      Loop
    End If
  Loop

  If (dic.Count > 0) Then
    With Range("A1")
      .Resize(dic.Count + 3, UBound(vA) + 3).Clear
      .Value = "残 mm"
      With .Offset(, 1).Resize(, UBound(vA))
        .Value = vA
        .NumberFormatLocal = "0 ""mm"""
      End With
      With .Offset(1).Resize(dic.Count)
        .Value = WorksheetFunction.Transpose(dic.Items)
        .TextToColumns .Cells(1), xlDelimited, Comma:=True
        With .Resize(, UBound(vA) + 1)
          .Sort .Cells(1), xlAscending, Header:=xlNo
          With .Offset(, 1).Resize(, .Columns.Count - 1)
            .NumberFormatLocal = "0 ""本"""
          End With
        End With
      End With
    End With
  End If
  Set dic = Nothing
End Sub

厳密に記述すると

>     For i = 0 To UBound(iA)
部分は
     For i = 0 To UBound(iA) - 1
と・・・
すべきかと・・・・

出力結果の範囲+2行2列をクリアしてから書き出しするので、1列分余計に空白のデータを作っていても実害はない・・・かな?


結果として表示されるのは、以下のようになります。
(修正した Samp2 の表示も同じです)

kEnt206Samp1.jpg

上記記述では、
  vA = Array(520, 580, 730, 980, 1030, 1240, CMAXLEN)
部分を変更することで、表示が変わるようになっています。
ただ、記述する順は昇順になるように・・・ これ、暗黙であります。
また、1番短いものは、許容差(COKLEN)より大きい事・・・ これも、暗黙であります。
さて、次に用意した Samp3 では、
  vA = Array(350, 480, 520, 580, 680, 730, 880, 980, 1030, 1170, 1240, CMAXLEN + 1)
に変更して、結果表示部分に色気を出して・・・ 以下の様な感じに

kEnt206Samp3.jpg

A列の「使用 mm」部分は、検算も兼ねて、1行目の mm と求めた本数とを SUMPRODUCT
「本数」部分には SUM、「種類数」部分には COUNT
を設定しています。

使っていくうちに、データが変わった・・・ さて、VBA 部分を書き換えるのも面倒・・・
という事で、Samp3 をシートに設定したデータで動くようにしたのが Samp4 と Sheet1

kEnt206Sheet1.jpg  kEnt206Samp4.jpg

せっかくなので、最低必要数も与えて・・・ Samp4 を元に変更したのが Samp5 と Sheet2

kEnt206Sheet2.jpg  kEnt206Samp5.jpg

kEnt206Sheet2_2.jpg  kEnt206Samp5_2.jpg

kEnt206Sheet2_3.jpg  kEnt206Samp5_3.jpg

※ シート上「サイズ」を入力する枠は10個分の所にしていますが、実際には意味ありません。
 C6 ~ その行の右端のものまでを対象にしています。
続きを読んでみようかな ---≫

2014/11/28

Category: 解説か

TB: --  /  CM: 0

top △

Excelシート名を得る 


質問者さんには不評だったものもありますが・・・・ (広告表示も間近なので)

CreateObject("Excel.Application") してからファイルをオープンして・・・
って例題もいっぱいあるし・・・似たようなものも過去記事にあるし・・・で

不慣れな以下2つを記述しておこうかと・・・・

・GetObject を使って
・ADODB の OpenSchema を使って

なお、これらの方法は Runtime 環境でもいけると思います。

ただし難点が・・・ 確認した環境は、Vista+2007 なのですが、
OpenSchema でやった場合、確認していた拡張子が xlsm ファイルでしたけど・・・
Excel ファイルの更新日時が変わっちゃうんですね・・・実行した時刻に・・・・
Excel ファイルの更新日時を見ながら何かしている状況では使えないかな?
他の拡張子ではどうなるんだろう??

ただね・・・ OpenSchema の方が速いんだよね・・・ GetObject より・・・
また、何らかのエラーがあっても Excel がゾンビっぽくならないし・・・
続きを読んでみようかな ---≫

2014/10/26

Category: 関数を作ってみる

TB: --  /  CM: 0

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。