Excelで遊んでました。配列とレンジ。

Option Explicit
Option Base 1
Sub 試験()
    Dim vnttmp As Variant
    Dim 実行 As Long
    Dim 実桁 As Long

    With Worksheets("Sheet1")
        vnttmp = .Range("A2", .Range("D65536").End(xlUp)).Value

    End With
    
    実行 = UBound(vnttmp, 1)
    実桁 = UBound(vnttmp, 2)
    
    vnttmp(10, 3) = "Takahashi"
    
    Worksheets("Sheet1").Range(Cells(2, 1), Cells(実行, 実桁)) = vnttmp
    
End Sub

Excelの場合は、2次元の配列を簡単に扱えるので、ワークシートから配列への読込や

その逆でも、1行で済むのが素晴らしいですね。でも色んな関数とかが書いてあれば

駄目のようですが。(^0^)

 

試験に使ったワークシートです。確かに1カ所変更になってます。

愛用のカメラですか?

　少し前までは5DMarkⅢでしたが、どうも使いこなせないので下取りして貰い

今は7DMarkⅡになってます。でもこのカメラは電池の消耗が激しい。初代の7D

も有るのですが、それと比べるとかなり電池が消耗します。GPS機能はオフにしてますが。

　機能的には7DMarkⅡが全てにおいて勝ってるとは思うんですが、実際撮って見て

使いこなせてないこともあるのでしょうが、余り関係ないようです。

　写真はクリックで拡大します。

　愛用のカメラで忘れてはいけないのが、OLYMPUS　TG-2です。いわゆるタフなので

濡れても心配ないし、山に行くときは軽量ですし、落としても心配ない。ただ撮ってる最中に

どういう感じで撮れてるか分からない事も多いので、帰って来てからガッカリのことも

あります。

　モードが変わってしまうんですね。自動のモードで通常は撮るんですが、いつの間にか

スーパーマクロになっていて、写真が数枚ピンボケもあります。

　写真はクリックで拡大します。

　今年の秋ですが、7Dを山に持って行ってました。しかし重いのでレンズは安物の

X3のレンズを付けてました。これがストラップから外れて、落としてしまいました。

水に入らないのがラッキーだったんでしょうね。少し傷があるのですが、正常に動作してます。

これは嬉しいですね。

　でもあとから見ると5DMarkⅢの写真の方が綺麗です。(^0^)もう買えません。

Excelリストボックスで遊んでました。続き。

Private Sub UserForm_InitializeCall()
  Dim 元表 As Range
  Dim i As Long
  'Dim dic As Object
  Dim 配列 As Variant
  Dim C配列 As Variant
 
 
 
  With Sheets("米検査日程")
    'Set 元表 = .Range("C2", .Range("IV2").End(xlToLeft)).Resize(2)
    Set 元表 = .Range("C2", .Range("IV3").End(xlToLeft))
  End With
 
  If Not (IsArray(元表)) Then
    配列 = Array(元表)
  Else
    配列 = 元表
  End If
 
  配列 = WorksheetFunction.Transpose(配列)

  C配列 = 配列
  Call 空白行削除(C配列, 配列)
 
  'Set dic = CreateObject("Scripting.Dictionary")
  With 検査日選択.ListBox1
    .ColumnCount = 2
    .ColumnWidths = "70;30"
    '.Column = 元表.Value
    .List = C配列
    
    'For i = .ListCount - 1 To 0 Step -1
    '    If Len(.List(i, 0)) = 0 Then
    '        .RemoveItem i
    '    ElseIf dic.Exists(.List(i, 0)) Then
    '        .RemoveItem i
    '    Else
    '        dic(.List(i, 0)) = Empty
    '    End If
    'Next
    
  End With
 
  Set 元表 = Nothing
  Set C元表 = Nothing
 
  'Set dic = Nothing


End Sub
Sub 空白行削除(Ctmp, tmp)
    Dim 書込行数 As Long
    Dim 実カラム As Long
    Dim 実行数 As Long
    Dim i As Long
    Dim j As Long
        
    
    実カラム = UBound(tmp, 2)
    実行数 = UBound(tmp, 1)
    書込行数 = 1
    
       
    For i = 1 To 実行数
        If tmp(i, 1) <> "" Then
            For j = 1 To 実カラム
                Ctmp(書込行数, j) = tmp(i, j)
            Next
            
            書込行数 = 書込行数 + 1
            
        End If
    Next
    
    For i = 書込行数 To 実行数
        For j = 1 To 実カラム
            Ctmp(i, j) = ""
        Next
    Next
    
End Sub

実際は動いていても、よく分からないところが有ったので、それを変えるとこうなるでしょう。

前は縦の表から、リストボックスのitemを設定しましたが、今回は横の表から作ると

どうなるかですね。

配列 = WorksheetFunction.Transpose(配列)を行えば、縦の表と同じく

出来ると言うことですね。

リストボックスは大体疑問が解決したような気がします。これで終わりですね。

Excelリストボックスで遊んでました。

Sub UserForm_InitializeCall()
    Dim dicTmp As Object
    Dim VntTmp As Variant
    Dim CpyVnttmp As Variant
    
    Dim VntV As Variant
    Dim i As Integer
    Dim j As Integer
    

    Set dicTmp = CreateObject("Scripting.Dictionary")
    With Worksheets("生産者")
        VntTmp = .Range("A2", .Range("D65536").End(xlUp)).Value

    End With
    
    'If Not IsArray(VntTmp) Then
    '    VntTmp = Array(VntTmp)
    'End If
                                      
    i = UBound(VntTmp, 1)
    j = UBound(VntTmp, 2)
    
    'VntTmp(10 + 1, 2 + 1) = "Chiba"
    
    CpyVnttmp = VntTmp               'Excelはこれでコピー出来ちゃう
    
    For Each VntV In VntTmp          'VntTmpとVntVは関係ない変数。何故こう書ける。
        On Error Resume Next         'ここでやっていることが正確には分からない。
        dicTmp.Add VntV, Empty
        On Error GoTo 0
    Next
    
    Call 空白行削除(CpyVnttmp, VntTmp) '上のi,jと数は同じ
    i = UBound(CpyVnttmp, 1)          '配列のitemにnullを代入しても
    j = UBound(CpyVnttmp, 2)          '配列は存在する

    
    With 農家選択.ListBox1
     .List = CpyVnttmp
     .ColumnWidths = "30;150;100;20"
     .ColumnCount = 4
    End With
    
    
    Set dicTmp = Nothing              'ディクショナリーを使わないと要らないでしょう。
    
    農家選択.Show

End Sub

Sub 空白行削除(Ctmp, tmp)
    Dim 書込行数 As Long
    Dim 実カラム As Long
    Dim 実行数 As Long
    Dim i As Long
    Dim j As Long
        
    
    実カラム = UBound(tmp, 2)
    実行数 = UBound(tmp, 1)
    書込行数 = 1
    
       
    For i = 1 To 実行数
        If tmp(i, 1) <> "" Then
            For j = 1 To 実カラム
                Ctmp(書込行数, j) = tmp(i, j)
            Next
            
            書込行数 = 書込行数 + 1
            
        End If
    Next
    
    For i = 書込行数 To 実行数
        For j = 1 To 実カラム
            Ctmp(i, j) = ""
        Next
    Next
    
End Sub

よく分からないままで、教えて貰ったコードを使ってましたが、この場合は配列の空白を

削除しないようです。Dictionaryを使えば、同じものコードのものが作られない、空白は

削除されると勘違いしてました。違う場面でもこのコードを使ってました。その場面とは

横に広がるワークシートです。しかも空白が多い。その場合でも旨く行ってたんですが。

疑問ですね。(^0^)

Excel2次元配列コピー

Sub UserForm_InitializeCall()
    Dim dicTmp As Object
    Dim VntTmp As Variant
    Dim CpyVnttmp As Variant
    
    Dim VntV As Variant
    Dim i As Integer
    Dim j As Integer
    

    Set dicTmp = CreateObject("Scripting.Dictionary")    'ディクショナリーを使わないと要らないでしょう。
    With Worksheets("生産者")
        VntTmp = .Range("A2", .Range("D65536").End(xlUp)).Value

    End With
    
    'If Not IsArray(VntTmp) Then　　　'ここから3行は普通は必要ないようです。
    '    VntTmp = Array(VntTmp)　　　 '上の3行でリストの元を作成してる場合必要ないようです。
    'End If
                                      'VntTmpの行数は分からないのが普通です。
    i = UBound(VntTmp, 1)             'データの行数と合う
    j = UBound(VntTmp, 2)             'データの項目数と合う
    
    VntTmp(10 + 1, 2 + 1) = "Chiba"  'データの部分だけ数えると行、カラムどちらも+1しないとずれますね。添え字は0から。
    
    CpyVnttmp = VntTmp　　　　　　　　'2次元の配列のコピーがこれで出来るんですが、何か分かりづらいですよね。
    
    For Each VntV In VntTmp          'この場合のように隙間が無いワークシートから表を作る場合は必要ないようです。
        On Error Resume Next
        dicTmp.Add VntV, Empty
        On Error GoTo 0
    Next
    
    
    
    With 農家選択.ListBox1
     .List = VntTmp
     .ColumnWidths = "30;150;100;20"
     .ColumnCount = 4
    End With
    
    
    Set dicTmp = Nothing              'ディクショナリーを使わないと要らないでしょう。
    
    農家選択.Show

End Sub
デバックで見たんですが、確かに実体が作られてました。VBとか一般の言語はアドレスだけが

コピーされるはずです。

紅白でお目当てはですね。

　有働アナウンサーが自分はお目当てですね。結構年なんでしょうが、一週間の平日に

毎日登場してるので、目が慣れてる。なんか顔が年の割には若い。正確な年は分かりません。

童顔なので（多分）憎めない顔です。(^0^)

Excelのリストボックスの使い方でいじりました。

Sub UserForm_InitializeCall()
    'Dim dicTmp As Object
    Dim VntTmp As Variant
    'Dim VntV As Variant
    Dim VntArry(2, 3) As Variant
    
    VntArry(0, 0) = 10
    VntArry(0, 1) = "厳美町○○"
    VntArry(0, 2) = "鈴木"
    VntArry(0, 3) = "39-1234"
    
    VntArry(1, 0) = 20
    VntArry(1, 1) = "厳美町△○"
    VntArry(1, 2) = "佐藤"
    VntArry(1, 3) = "39-2345"
    
    VntArry(2, 0) = 30
    VntArry(2, 1) = "厳美町○△"
    VntArry(2, 2) = "佐々木"
    VntArry(2, 3) = "39-3456"
    

    'Set dicTmp = CreateObject("Scripting.Dictionary")　　'ディクショナリーを使わないと要らないでしょう。
    'With Worksheets("生産者")
    '    VntTmp = .Range("A2", .Range("D65536").End(xlUp)).Value

    'End With
    
    'If Not IsArray(VntTmp) Then　　　'ここから3行は普通は必要ないようです。
    '    VntTmp = Array(VntTmp)　　　 '上の3行でリストの元を作成してる場合必要ないようです。
    'End If
     
    'For Each VntV In VntTmp　　　　　'この場合のように隙間が無いワークシートから表を作る場合は必要ないようです。
    '    On Error Resume Next
    '    dicTmp.Add VntV, Empty
    '    On Error GoTo 0
    'Next
    
    With 農家選択.ListBox1
     '.List = VntTmp
     .List = VntArry
     .ColumnWidths = "30;150;100;20"
     .ColumnCount = 4
    End With
    
    
    'Set dicTmp = Nothing              'ディクショナリーを使わないと要らないでしょう。
    
    農家選択.Show

End Sub
ワークシートからデータを取り込む場合は、最初の方ですね。でも2次元配列と形式が

似てるので、配列から設定することもありそうですよね。よく分からないのが今はコメントに

してますが、VntTmpが2次元配列と同等と言うことです。だったら同じように添え字で

アクセスできるんだろうか?

Excelのリストボックスの使い方でいじりました。

Option Explicit


Private Declare Function FindWindowEx Lib "User32" _
                    Alias "FindWindowExA" ( _
                    ByVal Hwnd1 As Long, _
                    ByVal Hwnd2 As Long, _
                    ByVal lpsz1 As String, _
                    ByVal lpsz2 As String) As Long

Private Declare Function GetWindowRect Lib "User32" ( _
                    ByVal Hwnd As Long, _
                    lpRect As RECT) As Long

Private Declare Function GetDC Lib "User32" ( _
                    ByVal Hwnd As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
                    ByVal hDC As Long, _
                    ByVal nIndex As Long) As Long

Private Declare Function ReleaseDC Lib "User32" ( _
                    ByVal Hwnd As Long, _
                    ByVal hDC As Long) As Long

Private Const LOGPIXELSX = 88
Private Const POINTS_PER_INCH As Long = 72

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Function PointsPerPixel() As Double
    Dim hDC As Long
    Dim lDotsPerInch As Long

    hDC = GetDC(0&)
    lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
    PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
    ReleaseDC 0&, hDC
End Function

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

    検査データ入力.生産者CD = ListBox1.List(ListBox1.ListIndex)
    検査データ入力.氏名 = ListBox1.List(ListBox1.ListIndex, 2)
    検査データ入力.住所 = ListBox1.List(ListBox1.ListIndex, 1)
    検査データ入力.電話番号 = ListBox1.List(ListBox1.ListIndex, 3)
    農家選択.Hide
    ListBox1.ListIndex = -1
    
End Sub

Private Sub UserForm_Initialize()

    Dim HwndDesk As Long
    Dim HwndChart As Long
    Dim uChartPos As RECT

    Dim Rng As Range

    Dim バージョン As String
    
    バージョン = Application.Version

    If バージョン = "11.0" Then

        Set Rng = ActiveCell(2)

        With Rng.Parent.ChartObjects.Add(0, 0, 1, 1)
            .Top = Rng.Top
            .Left = Rng.Left
            .Activate
            .Delete
        End With

        HwndDesk = FindWindowEx _
                    (Application.Hwnd, 0&, "XLDESK", vbNullString)
        HwndChart = FindWindowEx(HwndDesk, 0&, "EXCELE", vbNullString)
        GetWindowRect HwndChart, uChartPos

        StartUpPosition = 0

        Left = uChartPos.Left * PointsPerPixel
        Top = uChartPos.Top * PointsPerPixel
    End If

    Call UserForm_InitializeCall

End Sub


Private Sub UserForm_Click()

End Sub

Sub UserForm_InitializeCall()
    'Dim dicTmp As Object
    Dim VntTmp As Variant
    'Dim VntV As Variant

    'Set dicTmp = CreateObject("Scripting.Dictionary")　　'ディクショナリーを使わないと要らないでしょう。
    With Worksheets("生産者")
        VntTmp = .Range("A2", .Range("D65536").End(xlUp)).Value

    End With
    
    'If Not IsArray(VntTmp) Then　　　'ここから3行は普通は必要ないようです。
    '    VntTmp = Array(VntTmp)　　　 '上の3行でリストの元を作成してる場合必要ないようです。
    'End If
     
    'For Each VntV In VntTmp　　　　　'この場合のように隙間が無いワークシートから表を作る場合は必要ないようです。
    '    On Error Resume Next
    '    dicTmp.Add VntV, Empty
    '    On Error GoTo 0
    'Next
    
    With 農家選択.ListBox1
     .List = VntTmp
     .ColumnWidths = "30;150;100;20"
     .ColumnCount = 4
    End With
    
    
    'Set dicTmp = Nothing              'ディクショナリーを使わないと要らないでしょう。
    
    農家選択.Show

End Sub

ワークシートからリストボックスのitemを設定するところを、少しだけいじりました。

ほぼ100％丸写しだったので、調べたことを含みで直してみました。でもやはり

隙間があるワークシートから上手く作ることが出来ないので、やはり元の通りの

コードがベターですね。

でもArrayに変更してる箇所があるんですが、これは要らないような気もします。

そもそもがArrayだと思うんです。

Ｅｘｃｅｌのリストボックス

　自分自身それ程Ｅｘｃｅｌに詳しいわけではありません。しかし、幾らかでも役に立ちそうなことをしようと

すると、リストボックスに突き当たるように思います。ソフトというのは大概入力があって出力があります。

入力をするときに、記憶から入力するというのは、自分の場合は絶対出来ません。覚えられないし

間違います。例えば人を入力する場合は、コードを付けておいた方が何かと便利です。しかし、誰が

何番であるかは、覚えることが出来ないのが普通ですよね。一部は覚えておいたにしても、全部は無理。

　ユーザーフォームを使うことになるんですが、入力用の全体のフォームと例えば個人を選択するフォーム

とワークシートがあるとします。例えばの話しですので、ワークシートは今回はいじりません。入力の全体の

フォームと個人を選択するサブのフォーム。この場合はVBAを考えてますよ。

   以下の画像はクリックで拡大します。

全く教えて貰わないのは、このワークシートだけです。(^0^)

　

ユーザーフォームとワークシートの関係。

　

入力はかんな感じですかね。一部ですが。

この辺は教えた貰ったと言うよりも丸写しです。アクティブセルを感知して

その辺へユーザーフォームを開くのに必要です。無くても買わないかなあ。

　

選択した項目を入力のユーザーフォームへ送るのに必要な部分。

　

多分ここが肝なんでしょうが、要はデータ件数を基本は分からない。ワークシートから

リストボックスのitemを設定します。この辺も教えられたので、大体の事しか分かりません。

でも結構便利な部分です。Dictionaryを使ってます。

 

11/19最後は松島へ

　時間に余裕があるかと思い、松島観光を計画してました。実際は、それ程余裕が無かったんですが。

秋保大滝を出るときは、お昼を食べてましたので午後1時に近かったように思います。本当はかき小屋で

食い放題に挑戦したかったんですが、どうも妻も乗り気で無いし、第一ホテルの朝食でバイキングでした。

十分食べたので、食い放題はハッキリ言えば辟易でした。(^0^)

　9/9だったでしょうか?JA観光のミステリーツアーへ初めて参加したんですが、2日目が朝と昼とバイキング。

これにはすっかりお手上げでしたからね。もうそれ程食べられない年になったんですね。

　それでも五大堂の前のお土産屋さんで牡蠣を、殻付きです。1個食べました。五大堂、瑞巌寺（入り口まで）

遙か半世紀前に行ったきりで、覚えてなかったんですが、それなりに良かったですね。観光地でした。

　　

　東日本大震災の被害のあとが所々にありました。津波の最高水位や瑞巌寺の参道の杉が枯れて、再生の

工事中だったり。でも五大堂は無事のようですね。陸前高田や大槌ではビルの4階とかまで津波が来ている

ことから見れば、やはり松島は島のお陰で助かったようです。

　　　　

一等前後賞合わせて10億

　10億とはかなりの額ですね。当たればの話しですが。でも貧乏人がお金を持つと結構

トラブルに巻き込まれることもあるようですよ。昔ですが、一関で2億だったか当たった人が

いました。しかし最後は愛人だったか、知人だったかに殺されたんですよ。

　自分はそんな金は要らない。というか、宝くじを買わない。だらか絶対に当たりません。

でも10億あったら、欲しいものは悩まず買えるでしょうね。(^0^)

新築の家。5,000万。農機具の更新。1,500万。アウディの車。2,000万。どの位するか?

自転車100万。スリットボード30万。1Dx100万。

　取り敢えず残りは貯金ですかね。発想が貧乏なんですね。(^0^)

今欲しい家電は？

　ブルーレイレコーダーが欲しいんですが、パソコンでは再生できないし、結構高いですよね。

良いものだと8万位はするようです。これで録画してみれば見落としが無いと思うんですが

テレビ並みに高いのが欠点です。

　今年も買えないように思います。

11/19ニッカウィスキー宮城工場の見学のあと。

　仙台のビジネスホテルを9時頃だったでしょうか?出まして、作並街道国道48号だったでしょうかね。

西へ向かいました。ニッカウィスキーの工場へ着いて、見学の開始が10時からでした。その見学が

終了してから、鳳凰四十八滝というのを見ました。マッサンの工場からは直ぐ近くでした。工場からは

見栄えのする山が見えたんですが、その滝からも正面に見えました。あとから名前を調べると「鎌倉山」と

言うみたいでした。なかなか良い名前ですね。

　なんで良い名前かというと、NHKのニュースウェブのアナウンサーが鎌倉さんですからね。好きな番組です。

マッサンの工場は新川と広瀬川の合流点にあるんですね。ニッカと響きが似てます。ニッカは元の工場が

何とかと果汁から来てるようです。

　ここまで来たので「秋保大滝」も見ましょうと言うことで、仙台に戻る途中で右折して、秋保へ行きました。

そこは完全に観光地化されてました。寒い時期だったのですが、天気が良かったせいか、結構観光客が

来てました。

　滝は少し下ったところにあるのですが、伊豆の浄蓮滝から見れば楽ですね。でも少ししか見えないし

水しぶきも結構来ますね。そこそこに帰り、駐車場近くの食堂で昼食にしました。

写真はクリックで拡大します。

年賀状ですか?

　出来れば止めたいのですが、年に一度ですしね。中々止められません。(^0^)

自分は20枚程度ですが、妻が80枚程度ですかね。全部で100枚。年賀状を

買ってあります。まだ書いてません。

　パソコンで作るんですが、例年同じような感じになってしまいます。(^0^)

 

ニッカウヰスキーの宮城工場へ見学に行きました。

　NHKの朝ドラで放送された、「マッサンとエリー」だったでしょうか？いずれマッサンの造った

工場へ行ってきました。敷地面積は50,000㎡以上とかですし、従業員も100人以上居るようです。

しかし、見学関係者は目につきましたがウィスキーづくりの仕事に関係している人は目に

つきませんでした。

　自分は車で行ったので、試飲は出来ません。妻は運転しないつもりだったようで、試飲してました。

お茶とジュースを試飲しました。帰りにウィスキーの試飲をしない方は、試飲しないことを表示した

プレートを返却時にボールペンを貰いました。

　　　

 敷地内の池の水を抜いてました。車でドッカへ運ぶようです。

　　　

見学は10時からのコースでした。約30分で説明は終わります。その後は試飲とお土産の

コーナーへ案内されます。

　　　　

　　　　

写真はクリックで拡大します。