[[20190405103205]] 『上位先比較』(みずな) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『上位先比較』(みずな)

前期と当期の残高を上位先で抽出することはマクロでできるのでしょうか?

毎月の売掛金のデータを直近の前期、当期の上位先15件で推移して表を作成しております。

一度マクロを作れば時間短縮になると聞きました。
挑戦してみたいのですが何から手をつけてよいのか分からなかったのでこちらに相談させていただきます。

(データ)

コード 得意先名 C D E F G H I J

毎月有ります。
A列・・・コード
B列・・・得意先名
C列〜J列・・・金額
そのうち、完成表にはG列、I列、J列のデータを用いております。
但し、完成表の並びはJ、G、Iです。

(完成表)・・・1月〜2月まで

          H30/1  H30/2  H31/1  H31/2
コード 得意先名 J G I J G I J G I J G I

上位先は直近の月、この場合H30/2月とH31/2月になります。
上位先の抽出はJで行っております。

このようなことをマクロで行うことは可能なのでしょうか?
ご指示をお願い致します。

< 使用 Excel:Excel2016、使用 OS:Windows10 >


 >挑戦してみたいのですが何から手をつけてよいのか分からなかった
 まずはマクロの記録を試してみてください。
 検索は目で探すのではなく、Ctrl+Fを使ってみるとか。
 この説明だと何がしたいのかわからないです。
 記録したコードをこちらに張り付けてみてください。

 次に
  実際に近いデータ
  求める結果
 この二つを準備してください。
 コードはどのようなものなのか、数値なのか文字列なのか、桁数が一定なのかそうじゃないのか
 得意先とコードの関係がどうなっているのかさっぱりです。

 また上位先という言葉は一般的なのですか?
 私にはわからないので、説明していただけると役に立てると思います。

(稲葉) 2019/04/05(金) 11:51


大変、失礼いたしました。

マクロの記録?
調べてみますのでしばらくお待ちいただけないでしょうか?

データを一部加工しましたのでご参照下さい。

得意先ごとにコードがあります。
得意先は月によって変更されます。
C列〜J列には桁数が一定でない金額が入力されてありますが、空欄もあります。

(A列) (B列)  (C列)(D列 (E列)(F列)(G列) (H列)(I列) (J列)
コード 得意先名  前月残高 DDDD EEEE FFFF 当月残高 HHHH 総残高 年間売上
18 あああ株

26 II株
34 株EE
204 OO株
217 かかか株  

こちらのデータが毎月あります。
このデータの直近の月でJ列の年間売上の金額が上位15件について、当期と前期で抽出し推移表を
作成してます。

上位先とは金額が大きい得意先になります。
例えば2月が直近月の場合はH30/2月とH31/2月のデータそれぞれの年間売上金額のトップ15位を
抽出という意味です。

このそれぞれトップ15位の得意先を抽出し、その得意先の過去の推移表を作成しております。
H30/2月とH31/2月のトップ15位は違う場合がありますので、同じ得意先でない場合は追加します。

完成表の並びは下記です。
年間売上 当月残高 総残高
切れてしまいましたがH31/2月も右側に続きます。

(A列) (B列) (C列) (D列)  (E列) (F列)  (G列) (H列)( I列) (J列)   

                     H30/1月          H30/2月         H31/1月
コード	得意先	 年間売上 当月残高 総残高 年間売上 当月残高 総残高 年間売上 当月残高 総残高

まだ不明な点がありましたらご連絡ください。

(みずな) 2019/04/05(金) 13:50


稲葉様

マクロの記録ですが上位先15件の抽出は下記のとおりです。

Sub Macro1()

    Rows("1:1").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$J$2817").AutoFilter Field:=10, Criteria1:="15", _
        Operator:=xlTop10Items
End Sub

いつもは、この作業を直近の前期(H30/2月)と当期(H31/2月)でそれぞれ行います。
それぞれの結果のコードと得意先を下に繋げて、コードの重複の削除をしています。

H30/2月期の結果
H31/2月期の結果←下に並べます。

Sub Macro2()

    Columns("A:A").Select
    ActiveSheet.Range("$A$1:$J$2817").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
        , 7, 8, 9, 10), Header:=xlYes
End Sub

重複の削除されたコードと得意先に応じて、それぞれの月の金額をVLOOKUPしております。

このような説明で大丈夫でしょうか?
不備等がありましたら教えてください。

(みずな) 2019/04/05(金) 14:27


 私は読解力ないので、表にして提示してもらえませんか?

 今のところ特にわからないのは
 当期と前期の表がどこにあるかもわからない。
 直近月がどこを見ればわかるのかわからない。
 完成表がどのようになればいいのかわからない。

(稲葉) 2019/04/05(金) 15:58


稲葉様

Excelを一部加工して貼り付けてみましたが上手に表示されておらず
ご迷惑をおかけしております。

何かよい方法を考えてみます。
申し訳ございませんが急ぎの仕事が入ってしまいましたので来週
ご提示させていただきます。

もしご迷惑でなければ表を見て頂けないでしょうか。
よろしくお願いいたします。

(みずな) 2019/04/05(金) 17:09


 こういうの使ってみてください。
[[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか?』(momo) 
(稲葉) 2019/04/05(金) 18:26

稲葉 様

遅くなりまして申し訳ございません。
教えて頂いた式を使用してみましたが桁数によって上手に表示されないですが大丈夫でしょうか?

各月のサンプル10件です。
上位5件、直近2月の場合です。

よろしくご指導お願いします。

(前期1月)

     |[A]   |[B]     |[C]        |[D]       |[E]      |[F]       |[G]        |[H]       |[I]        |[J]        
 [1] |コード|得意先名|CC         |DD        |EE       |FF        |当月残高   |HH        |総債権残高 |年間売上   
 [2] |    18|A社     |112,696,497|80,040,556|6,403,247|77,618,128|121,522,172|         0|121,522,172|813,579,836
 [3] |    26|B社     |          0|         0|        0|         0|          0|         0|          0|          0
 [4] |    34|C社     |  5,625,612|         0|        0|         0|  5,625,612|         0|  5,625,612|  5,208,900
 [5] |   204|D社     |          0|         0|        0|         0|          0|         0|          0|          0
 [6] |   217|E社     | 18,998,280|         0|        0|         0| 18,998,280|         0| 18,998,280| 17,591,000
 [7] |   607|F社     |△ 518,562 |         0|        0|△ 518,562|          0|         0|          0|          0
 [8] |   618|G社     |          0|         0|        0|         0|          0|         0|          0|  9,971,200
 [9] |   804|H社     |          0|         0|        0|         0|          0|12,690,950| 12,690,950| 24,444,420
 [10]|   812|I社     |          0| 6,865,200|  549,216|         0|  7,414,416|         0|  7,414,416| 62,912,300
 [11]|   901|J社     | 12,204,000| 1,080,000|   86,400| 4,514,400|  8,856,000|         0|  8,856,000| 53,762,000

(前期2月)

     |[A]   |[B]     |[C]      |[D]|[E]|[F]       |[G]     |[H]      |[I]       |[J]       
 [1] |コード|得意先名|CC       |DD |EE |FF        |当月残高|HH       |総債権残高|年間売上  
 [2] |    18|A社     |3,931,200|  0|  0| 3,931,200|       0|        0|         0| 3,640,000
 [3] |   217|E社     |        0|  0|  0|         0|       0|        0|         0| 7,700,000
 [4] | 24214|K社     |        0|  0|  0|         0|       0|3,865,752| 3,865,752|19,569,400
 [5] |   901|J社     |        0|  0|  0|         0|       0|        0|         0|         0
 [6] | 24222|L社     |        0|  0|  0|         0|       0|        0|         0|         0
 [7] |   812|I社     |      392|  0|  0|       392|       0|  172,408|   172,408|   160,000
 [8] | 25202|M社     |        0|  0|  0|         0|       0|        0|         0|   242,500
 [9] |    26|B社     |    4,040|  0|  0|△ 352,414| 356,454|  167,400|   523,854|         0
 [10]|  2080|N社     |        0|  0|  0|         0|       0|        0|         0|   691,200
 [11]|  4078|O社     |   24,170|  0|  0|    24,170|       0|        0|         0|   124,480

(当期1月)

     |[A]   |[B]     |[C]    |[D]      |[E]    |[F]    |[G]      |[H]|[I]       |[J]      
 [1] |コード|得意先名|CC     |DD       |EE     |FF     |当月残高 |HH |総債権残高|年間売上 
 [2] |    18|A社     |161,180|        0|      0|161,180|        0|  0|         0|1,382,220
 [3] |  4078|O社     |      0|4,230,000|338,400|      0|4,568,400|  0| 4,568,400|4,230,000
 [4] |   217|E社     |282,134|△ 1,856 |△ 148 |280,130|        0|  0|         0|  350,277
 [5] | 24214|K社     |      0|1,264,400|101,152|      0|1,365,552|  0| 1,365,552|9,674,398
 [6] |   607|F社     |      0|        0|      0|      0|        0|  0|         0|  197,400
 [7] |  6110|P社     |  6,739|        0|      0|  6,739|        0|  0|         0|    6,240
 [8] |  6145|Q社     |      0|        0|      0|      0|        0|  0|         0|  560,800
 [9] |   618|G社     |319,140|        0|      0|319,140|        0|  0|         0|  437,000
 [10]| 25202|M社     |      0|        0|      0|      0|        0|  0|         0|  262,800
 [11]|    34|C社     |  8,294|        0|      0|      0|    8,294|  0|     8,294|    7,680

(当期2月)

     |[A]   |[B]     |[C]      |[D]      |[E]   |[F]    |[G]      |[H]       |[I]       |[J]       
 [1] |コード|得意先名|CC       |DD       |EE    |FF     |当月残高 |HH        |総債権残高|年間売上  
 [2] | 25202|M社     |  482,760|1,074,000|85,920|482,760|1,159,920|10,936,672|12,096,592|18,932,000
 [3] |   607|F社     |        0|        0|     0|      0|        0|         0|         0|   134,500
 [4] | 24214|K社     |  145,476|        0|     0|      0|  145,476|         0|   145,476|   134,700
 [5] |   618|G社     |4,568,400|        0|     0|      0|4,568,400|         0| 4,568,400| 7,402,500
 [6] |    34|C社     |    7,582|        0|     0|      0|    7,582|         0|     7,582|     7,020
 [7] |   901|J社     |    2,916|        0|     0|      0|    2,916|         0|     2,916|     2,698
 [8] |   217|E社     |3,931,200|        0|     0|      0|3,931,200|         0| 3,931,200| 3,640,000
 [9] |    18|A社     |  531,468|        0|     0|      0|  531,468|         0|   531,468|   492,100
 [10]|   812|I社     |        0|        0|     0|      0|        0|         0|         0|     7,270
 [11]|  6110|P社     |        0|        0|     0|      0|        0|         0|         0|   134,000

(結果)

    |[A]   |[B]     |[C]        |[D]        |[E]        |[F]       |[G]     |[H]       |[I]      |[J]      |[K]       |[L]       |[M]      |[N]       
 [1]|      |        |           |前期1月    |           |前期2月   |        |          |当期1月  |         |          |当期2月   |         |          
 [2]|コード|得意先名|年間売上   |当月残高   |総債権残高 |年間売上  |当月残高|総債権残高|年間売上 |当月残高 |総債権残高|年間売上  |当月残高 |総債権残高
 [3]|    18|A社     |813,579,836|121,522,172|121,522,172| 3,640,000|       0|         0|1,382,220|        0|         0|   492,100|  531,468|   531,468
 [4]|   217|E社     | 17,591,000| 18,998,280| 18,998,280| 7,700,000|       0|         0|  350,277|        0|         0| 3,640,000|3,931,200| 3,931,200
 [5]|   618|G社     |  9,971,200|          0|          0|#N/A      |#N/A    |#N/A      |  437,000|        0|         0| 7,402,500|4,568,400| 4,568,400
 [6]|  2080|N社     |#N/A       |#N/A       |#N/A       |   691,200|       0|         0|#N/A     |#N/A     |#N/A      |#N/A      |#N/A     |#N/A      
 [7]| 24214|K社     |#N/A       |#N/A       |#N/A       |19,569,400|       0| 3,865,752|9,674,398|1,365,552| 1,365,552|   134,700|  145,476|   145,476
 [8]| 25202|M社     |#N/A       |#N/A       |#N/A       |   242,500|       0|         0|  262,800|        0|         0|18,932,000|1,159,920|12,096,592

(みずな) 2019/04/15(月) 12:57


 >重複の削除されたコードと得意先に応じて、それぞれの月の金額をVLOOKUPしております。 
 とのことでしたので、結果シートに当期2月と前期2月の重複しないコードと得意先名を出力するところに
 留めました。
 同じブック上でシート名が「当期2月」「前期2月」の場合を想定しております。

    Sub test()
        Dim mon As String
        Dim sns(1) As String
        Dim n As Long
        mon = InputBox("基準となる月を入力してください", , "2")
        'シート名チェック
        If Not IsNumeric(mon) Then MsgBox "月を数字で入力してください": Exit Sub
        sns(0) = "当期" & mon & "月"
        sns(1) = "前期" & mon & "月"
        For n = 0 To 1
            If Not Evaluate("ISREF(" & sns(n) & "!A1)") Then MsgBox sns(n) & "のシートが存在しません": Exit Sub
        Next n

        '当期直近の月と、前期同月の年間売上 上位15位のコード、得意先名を取得する
        Sheets("結果").Range("A3:B" & Rows.Count).ClearContents
        For n = 0 To 1
            With Sheets(sns(n))
                .Range("A1").CurrentRegion.AutoFilter Field:=10, Criteria1:="15", Operator:=xlTop10Items
                .Range("A2", .Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
                Sheets("結果").Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlValue
                .ShowAllData
            End With
        Next n
        Sheets("結果").Range("A2:B" & Rows.Count).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    End Sub
(稲葉) 2019/04/15(月) 19:00

稲葉 様

ありがとうございます。
まだ解読の途中ですが少し教えて頂けないでしょうか。

1.上位の抽出件数もメッセージBOXにしたい場合は下記の修正で大丈夫でしょうか。

>mon = InputBox("基準となる月を入力してください", , "2")
>.Range("A1").CurrentRegion.AutoFilter Field:=10, Criteria1:="15", Operator:=xlTop10Items

NB = InputBox("上位抽出件数を入力してください", , "15")
.Range("A1").CurrentRegion.AutoFilter Field:=10, Criteria1:=NB, Operator:=xlTop10Items

>Operator:=xlTop10Items

こちらも数字も件数に応じて修正すべきなのでしょうか。

2.買掛金も同じように上位先の抽出を行うのですが参照する列が違う場合下記の修正で大丈夫でしょうか。

>.Range("A1").CurrentRegion.AutoFilter Field:=10, Criteria1:="15", Operator:=xlTop10Items
>.Range("A2", .Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Copy

列が5列、上位金額はC列の場合、

>.Range("A1").CurrentRegion.AutoFilter Field:=5, Criteria1:="15", Operator:=xlTop10Items
>.Range("A2", .Cells(Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible).Copy

3.VLOOKUPまでマクロで行いたい場合ですが調べたらApplication.を冒頭に使用すればマクロでも
VLOOKUPが使用できるとありましたが範囲が特定できない場合はどのように式を書いたらよいのでしょうか。

ご指導頂けないでしょうか。
宜しくお願い致します。

(みずな) 2019/04/15(月) 20:32


 まず提示したコードで問題なかったのでしょうか?
(稲葉) 2019/04/16(火) 07:58

要件が違うかもしれませんが、投稿してみます。
標準モジュールに張り付けてご使用ください。

Option Explicit

Sub Sample()

    Const ErrMsg001 As String = "1から12の数値を入力してください。"
    Const ErrMsg002 As String = "数値を入力してください。"
    Dim dbCon As Object
    Dim adoRs As Object
    Dim sql As String
    Dim lCol As Long
    Dim argSplit As Variant
    Dim baseMonth As String
    Dim NB As String
    Dim sht As Excel.Worksheet

    baseMonth = InputBox("基準となる月を入力してください", , month(DateAdd("m", -1, Now())))

    If IsMonth(baseMonth) = False Then
        MsgBox ErrMsg001, vbCritical
        Exit Sub
    End If

    NB = InputBox("上位抽出件数を入力してください", , "15")

    If IsNumeric(NB) = False Then
        MsgBox ErrMsg002, vbCritical
        Exit Sub
    End If

    Set dbCon = CreateObject("ADODB.Connection")
    With dbCon
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Properties("Extended Properties") = "Excel 8.0"
        .Open ThisWorkbook.Path & "\" & ThisWorkbook.Name
    End With

    Set adoRs = CreateObject("ADODB.Recordset")
    adoRs.CursorLocation = 3

    sql = getSQL(baseMonth, NB)

    adoRs.Open sql, dbCon, 1, 1

    Set sht = ThisWorkbook.Sheets("結果")

    sht.Cells.ClearContents

    For lCol = 1 To adoRs.Fields.Count
        argSplit = Split(adoRs.Fields(lCol - 1).Name, "_")

        Select Case UBound(argSplit)
            Case 1:
                sht.Cells(1, lCol).Value = argSplit(0)
                sht.Cells(2, lCol).Value = argSplit(1)
            Case Else:
                sht.Cells(2, lCol).Value = adoRs.Fields(lCol - 1).Name
        End Select
    Next

    sht.Range("A3").CopyFromRecordset adoRs

    Set adoRs = Nothing
    dbCon.Close
    Set dbCon = Nothing
End Sub

Private Function IsMonth(ByVal Val As String) As String

    Dim reg As RegExp

    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "^[1-9]$|^1[0-2]$"

    IsMonth = reg.test(Val)
End Function

Private Function getSQL(ByVal month As String, ByVal top As String) As String

    Dim sql As String

    sql = "SELECT TOP " & top
    sql = sql & "     B.コード "
    sql = sql & "   , B.得意先名 "
    sql = sql & "   , J.年間売上   AS 前期" & month & "月_年間売上 "
    sql = sql & "   , J.当月残高   AS 前期" & month & "月_当月残高 "
    sql = sql & "   , J.総債権残高 AS 前期" & month & "月_総債権残高 "
    sql = sql & "   , B.年間売上   AS 当期" & month & "月_年間売上 "
    sql = sql & "   , B.当月残高   AS 当期" & month & "月_当月残高 "
    sql = sql & "   , B.総債権残高 AS 当期" & month & "月_総債権残高 "
    sql = sql & " FROM "
    sql = sql & "   [当期" & month & "月$] B "
    sql = sql & "   LEFT JOIN [前期" & month & "月$] J "
    sql = sql & "       ON B.コード = J.コード "
    sql = sql & " ORDER BY "
    sql = sql & "   B.年間売上 DESC "

    getSQL = sql
End Function

(猫の手) 2019/04/16(火) 20:42


稲葉 様

昨日返事させていただいたのですが上手く投稿できておりませんでした。
申し訳ございません。

ご提示いただいたコードはテストデータでは稲葉様がおっしゃられたとおり
当期2月と前期2月の重複しないコードと得意先名を出力されました。

(みずな) 2019/04/17(水) 11:04


猫の手 様

ありがとうございます。
すいません少し教えて頂きたいのですが

ご提示いただいたコードを実行してみたらコンパイルエラーが表示されました。
メッセージは「ユーザー定義型は定義されません」と表示され
Private Function IsMonth(ByVal Val As String) As Stringが黄色くなっております。

私の操作ミスでしょうか。

ご指導頂けないでしょうか。

(みずな) 2019/04/17(水) 11:12


失礼しました。
スマホからなので、分かりづらければごめんなさい。

黄色くなった行のすぐ下を下記のように変更ください。

Dim reg as Object
(猫の手) 2019/04/17(水) 11:26


 希望通りの結果でよかったです。
 猫の手さんのSQLのほうがスマートなので、そちらで解決いただければと思います。

 一点だけ・・・私も受け売りなんですが、
 >        .Open ThisWorkbook.Path & "\" & ThisWorkbook.Name
 自分自身をDB扱いはやめたほうがいいそうです。
 seiyaさんから教えていただきました。
 savecopyasで複製作り、複製を参照されたほうが良いみたいです。

 一応質問の回答ですが
 1については、ご自身で実行して問題なければよいと思いますが、いかがでしたか?
 2については、買掛金がどこにあるのかわからないので、なんとも言えません。
  総売り上げとどう関係するのかも分からないのでこちらも何とも言えないです。
 3については、毎月シートが増える、同じブック内である、ならばINDIRECT関数で解決できそうです。(マクロ不要)

(稲葉) 2019/04/17(水) 11:37


猫の手 様

ありがとうございます

先ほどの箇所は問題ないようです。

ですが今度は違う箇所でエラーが表示されました。
実行時エラー3706 プロバイダーが見つかりません。
正しくインストールされたいない可能性があります。
.Properties("Extended Properties") = "Excel 8.0"が黄色くなりました。

Excelのバージョンと関係あるのでしょか?
因みにバージョンはExcel for office 365 MSOです。

8.0をfor office 365 MSOに修正してもダメでした。

どのようにしたらよろしいのでしょうか。
ご指導頂けないでしょうか。

(みずな) 2019/04/17(水) 13:02


稲葉 様

>自分自身をDB扱いはやめたほうがいいそうです。

DB?
調べてみます。
自分で作成する際に参考にさせていただきます。

 
稲葉様がご提示いただいたコードをきちんと理解したいと思い違うデータ
の場合や応用の場合にどのようになるのか知りたくて質問させていただきました。

1は自分で調べましたが
>Operator:=xlTop10Items
も件数に応じて修正しなくても大丈夫かどうかは知識不足で分かりませんでした。

2ですが、売掛金と同じようなデータで買掛金がございましたので応用で列が変わった
場合に修正する箇所があっているのか全然違う箇所を修正すべきなのかが知りたかったです。

3はコードと得意先だけでなく比較表の作成までマクロで行う予定です。

ご提示いただいたデータの理解不足で自分なりに修正してみましたが上手くいきませんでした。
やりたい事に近づけるよう勉強していきます。

ありがとうございます。
(みずな) 2019/04/17(水) 13:16


エクセルのバージョンまで見ていませんでした。
ごめんなさい。

Excel 12.0

で試してください。

To 稲葉さん
情報ありがとうございます。
普段あまりExcelVBAを使わないので、その辺の情報収集を
行っていませんでした。
メモリリーク関係ですかね?

(猫の手) 2019/04/17(水) 13:32


 みずなさん
 前半は猫の手さんに当てた内容です。すみません。

 1について
 >>Operator:=xlTop10Items 
 >も件数に応じて修正しなくても大丈夫かどうかは知識不足で分かりませんでした。 
https://docs.microsoft.com/ja-jp/office/vba/api/excel.xlautofilteroperator
 AutoFilterメソッドのパラメーター Operatorについてです。
 定数が決められていて、今回はTop10で大丈夫です。

 2について
 >列が5列、上位金額はC列の場合、 
 A列から始まる表で、買掛金がE列であれば、Field:=5で大丈夫です。
 これが、B列から始まるデータで、買掛金がE列にある場合はField:=4になります。
 Fieldはフィルターの範囲の左端から何列目を指定する必要があります。

 C列に金額があろうが、最終行を求める列がどこかによって決めるので、
 B列(得意先名)が無難と思います。

 3について
 猫の手さんのコードが気に入ってしまったので、これ以上加筆するつもりはありませんが、
 結果だけ求めるなら、WorksheetFunctionオブジェクトでできると思います。
https://docs.microsoft.com/ja-jp/office/vba/api/excel.worksheetfunction
 ただ、個人的には数式でできるところは、数式にしておくほうが後々管理しやすいとは思いますねぇ・・・。

 猫の手さん
 そのようです!
 私も詳しく知らないくせに、コードに対して口をはさんだ形になり申し訳ないです。

(稲葉) 2019/04/17(水) 15:11


猫の手 様

どうしてでしょうか。
8.0から12.0に変更してもエラーが表示されます。
試しに2016としてみましたがダメでした。

エラー内容は一緒で黄色くなる箇所も同じです。

こちらもPCに問題があるのでしょうか。

ご指導頂けないでしょうか。

(みずな) 2019/04/17(水) 16:29


 これって、Providerも直さないといけないんじゃないんですかね?
 最近勉強し始めたところなんで自信ないですけど、

 >       .Provider = "Microsoft.Jet.OLEDB.4.0"

 ↑を、↓にでどうでしょうか?見当違いかな?(^^;

 .Provider = "Microsoft.ACE.OLEDB.12.0"

(虎) 2019/04/17(水) 16:52


朝からずっとパソコンが使える環境にないので、申し訳ない
です。

私の下記環境では、最初のコードでRegexの参照設定を追加
すれば動いているんです。

Windows10+excel2016 32bit
Windows7+Excel2010 32bit

もしかするとAccess関係のランタイムがないのかもしれません。
私のコードは一旦、忘れて頂いたほうがいいかも知れません。

(猫の手) 2019/04/17(水) 17:38


64bitWindowsにはJet.OLEDB4.0がインストールされていない。
と記述されているサイトを発見しました。
スマホからの検索なので、あまり多くのサイトは見ていませんので
確実ではないかも知れません。

虎さんのご指摘のされているプロバイダ名を試して頂けると、動く
かも知れません。

(猫の手) 2019/04/17(水) 18:07


虎 様

ありがとうございます。
エラー出なくなりました。

(みずな) 2019/04/22(月) 12:36


猫の手 様

虎様に教えて頂いた修正でエラーが出なくなりました。

ですが抽出結果が基準となる月の前期と当期のみでそれ以外の月が抽出できて
いなかったです。

それと、基準となる月に関しては前期からも上位抽出するのですが結果は当期
の上位抽出先に対する前期となっておりました。

テストデータで基準となる月を2月、上位抽出件数を5件とすると、下記結果になるのですがN社が検出されておりませんでした。

ご指導頂けないでしょうか。
宜しくお願い致します。

 |[A]   |[B]     |[C]        |[D]        |[E]        |[F]       |[G]     |[H]       |[I]      |[J]      |[K]       |[L]       |[M]      |[N]       
 [1]|      |        |           |前期1月    |           |前期2月   |        |          |当期1月  |         |          |当期2月   |         |          
 [2]|コード|得意先名|年間売上   |当月残高   |総債権残高 |年間売上  |当月残高|総債権残高|年間売上 |当月残高 |総債権残高|年間売上  |当月残高 |総債権残高
 [3]|    18|A社     |813,579,836|121,522,172|121,522,172| 3,640,000|       0|         0|1,382,220|        0|         0|   492,100|  531,468|   531,468
 [4]|   217|E社     | 17,591,000| 18,998,280| 18,998,280| 7,700,000|       0|         0|  350,277|        0|         0| 3,640,000|3,931,200| 3,931,200
 [5]|   618|G社     |  9,971,200|          0|          0|#N/A      |#N/A    |#N/A      |  437,000|        0|         0| 7,402,500|4,568,400| 4,568,400
 [6]|  2080|N社     |#N/A       |#N/A       |#N/A       |   691,200|       0|         0|#N/A     |#N/A     |#N/A      |#N/A      |#N/A     |#N/A      
 [7]| 24214|K社     |#N/A       |#N/A       |#N/A       |19,569,400|       0| 3,865,752|9,674,398|1,365,552| 1,365,552|   134,700|  145,476|   145,476
 [8]| 25202|M社     |#N/A       |#N/A       |#N/A       |   242,500|       0|         0|  262,800|        0|         0|18,932,000|1,159,920|12,096,592

(みずな) 2019/04/22(月) 12:50


今回の説明でなんとなくわかったような気がします。
getSQL関数を下記に書き換えて試してみてください。

Private Function getSQL(ByVal thisMonth As String, ByVal top As String) As String

    Dim sql As String
    Dim lastMonth As String

    lastMonth = IIf(thisMonth = "1", "12", Trim(Str(val(thisMonth) - 1)))

    sql = "SELECT  "
    sql = sql & "     B3.コード "
    sql = sql & "   , B3.得意先名 "
    sql = sql & "   , J1.年間売上   AS 前期" & lastMonth & "月_年間売上 "
    sql = sql & "   , J1.当月残高   AS 前期" & lastMonth & "月_当月残高 "
    sql = sql & "   , J1.総債権残高 AS 前期" & lastMonth & "月_総債権残高 "
    sql = sql & "   , J2.年間売上   AS 前期" & thisMonth & "月_年間売上 "
    sql = sql & "   , J2.当月残高   AS 前期" & thisMonth & "月_当月残高 "
    sql = sql & "   , J2.総債権残高 AS 前期" & thisMonth & "月_総債権残高 "
    sql = sql & "   , J3.年間売上   AS 当期" & lastMonth & "月_年間売上 "
    sql = sql & "   , J3.当月残高   AS 当期" & lastMonth & "月_当月残高 "
    sql = sql & "   , J3.総債権残高 AS 当期" & lastMonth & "月_総債権残高 "
    sql = sql & "   , J4.年間売上   AS 当期" & thisMonth & "月_年間売上 "
    sql = sql & "   , J4.当月残高   AS 当期" & thisMonth & "月_当月残高 "
    sql = sql & "   , J4.総債権残高 AS 当期" & thisMonth & "月_総債権残高 "
    sql = sql & "FROM "
    sql = sql & "    ((((SELECT "
    sql = sql & "         コード "
    sql = sql & "       , 得意先名 "
    sql = sql & "    FROM "
    sql = sql & "       ( "
    sql = sql & "           SELECT "
    sql = sql & "                 TOP " & top
    sql = sql & "                 B1.コード "
    sql = sql & "               , B1.得意先名 "
    sql = sql & "           FROM "
    sql = sql & "               [当期" & thisMonth & "月$] B1 "
    sql = sql & "           ORDER BY "
    sql = sql & "               B1.年間売上 DESC "
    sql = sql & "       ) "
    sql = sql & "    UNION ( "
    sql = sql & "           SELECT "
    sql = sql & "                 TOP " & top
    sql = sql & "                 B2.コード "
    sql = sql & "               , B2.得意先名 "
    sql = sql & "           FROM "
    sql = sql & "               [前期" & thisMonth & "月$] B2 "
    sql = sql & "           ORDER BY "
    sql = sql & "               B2.年間売上 DESC "
    sql = sql & ")) B3"
    sql = sql & "    LEFT JOIN [前期" & lastMonth & "月$] J1 "
    sql = sql & "        ON B3.コード = J1.コード) "
    sql = sql & "    LEFT JOIN [前期" & thisMonth & "月$] J2 "
    sql = sql & "        ON B3.コード = J2.コード) "
    sql = sql & "    LEFT JOIN [当期" & lastMonth & "月$] J3 "
    sql = sql & "        ON B3.コード = J3.コード) "
    sql = sql & "    LEFT JOIN [当期" & thisMonth & "月$] J4 "
    sql = sql & "        ON B3.コード = J4.コード "

    getSQL = sql
End Function

(猫の手) 2019/04/22(月) 20:02


猫の手 様

ありがとうございます。
ご提示頂いたコードで2月分(ふたつきぶん)の比較表は作ることができました。

こちら基準となる月以前の全ての月の比較表を作る場合(例えば基準となる月が
4月の場合、1月〜4月の比較表)は下記コードのJ1の数字を増やしていけば大丈夫
なのでしょうか。

>sql = sql & " , J1.年間売上 AS 前期" & lastMonth & "月_年間売上 "
>sql = sql & " , J1.当月残高 AS 前期" & lastMonth & "月_当月残高 "
>sql = sql & " , J1.総債権残高 AS 前期" & lastMonth & "月_総債権残高 "
>sql = sql & " LEFT JOIN [前期" & lastMonth & "月$] J1 "
>sql = sql & " ON B3.コード = J1.コード) "

それとこのコードはAccessに接続して処理を行っているのでしょうか。
このPCはAccessが入っているのですが入ってないPCでも大丈夫でしょうか。

今日は入ってないPCが持ち出されており試せておりませんが可能であれば
Accessの結合で行いたいことがあります。

ご指導頂けないでしょうか。
宜しくお願い致します。

(みずな) 2019/04/24(水) 14:34


>4月の場合、1月〜4月の比較表)は下記コードのJ1の数字を増やしていけば大丈夫
>なのでしょうか。

SELECT句の追加はその通りです。
FROM句の追加は括弧の追加が必要です。

>それとこのコードはAccessに接続して処理を行っているのでしょうか。
>このPCはAccessが入っているのですが入ってないPCでも大丈夫でしょうか。

Accessに接続しているわけではなく、ADOを使用してJETエンジンもしくはACEエンジンを使用して
SQLを実行しています。

(猫の手) 2019/04/24(水) 21:02


猫の手 様

追加が上手くいきません。

FROM句の構文エラーが出ます。
括弧の追加の方法を教えて頂けないでしょうか。

>Accessに接続しているわけではなく、ADOを使用してJETエンジンもしくはACEエンジンを使用して
>SQLを実行しています。

LEFT JOIN があるのでAccessだと勘違いしました。
Accessが入ってないPCでも結合できればと思っていたので驚きです。

ただマクロが作れるかですね。
頑張って勉強します。

(みずな) 2019/05/04(土) 13:02


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.