LoginSignup
9
18

More than 3 years have passed since last update.

Excelマクロ(VBA)×Pythonスクレイピングで成長株探しを自動化

Last updated at Posted at 2021-01-04

今回はVBAとPythonを組み合わせて、成長株を自動抽出するマクロ(以下、成長株検索マクロ)を作成しました!
成長株の条件は、直近に決算発表をした国内株のうち以下の条件のいずれかに当てはまる銘柄です。

  • 売上高営業利益率が10%以上、1年間売上高成長率が20%以上
  • 売上高営業利益率が10%以上、決算データが最新年分しかない(新規公開株、決算期の変更等)

マクロの概要と処理内容を解説していきます。Excelマクロでこんなことができるのかという参考になれば嬉しいです!

目次

1.成長株検索マクロの概要
2.使うための準備
3.コード全文
4.各処理の解説

1. 成長株検索マクロの概要

成長株検索マクロには以下の2つの機能があります。

①Excelを開いたときに自動で前日が決算発表日の成長株を自動抽出
②指定日検索ボタンで入力した日付が決算発表日の成長株を自動抽出

機能①:前日成長株検索

Excelを開くと、自動で前日が決算発表日の銘柄を抽出します。

成長株検索マクロ開くと、国内上場企業の決算短信データをExcel形式でダウンロードできる決算プロというサイトから最新の決算短信データがダウンロードされます。
決算データダウンロード中.jpg
ダウンロードしたデータから、前日が決算発表日かつ冒頭に書いた条件に当てはまる銘柄データを成長株検索マクロのブックに自動でコピーしてきます。
自動コピー結果.jpg

機能②:指定日成長株検索

成長株検索マクロ内の指定日検索ボタンを押すと日付入力欄が表示されます。
日付入力欄.jpg
入力した日付が決算発表日かつ冒頭に書いた条件に当てはまる銘柄データを、機能①と同じように成長株検索マクロのブックに自動でコピーしてきます。決算短信データは機能①でダウンロードしたものを利用します。

ちなみに決算発表スケジュールを調べるのはSBI証券の決算発表カレンダーが便利です。

2. 使うための準備

成長株検索マクロを使うために必要な環境について記載していきます。

①OSがWindowsのPC

MacやLinuxでの動作は確認していません。

②officeソフト

Excelを使うので当然必要になります。office2010~office365までは動作確認済です。

③GoogleChrome、Python3、Selenium、chromedriver

決算データをダウンロードする機能で使います。
それぞれ以下のサイトでダウンロードやセットアップ手順が記載されています。

④xlwings、pywin32

VBA(Excelマクロ)からpythonファイルを実行するために必要です。無限不可能性ドライブというサイトがわかりやすくインストール手順を解説してくれています。

3. コード全文

成長株検索マクロで使用しているVBA、Pythonのコード全文を記載します。

前日成長株検索機能のマクロ

前日成長株検索
Option Explicit

Dim bookName As String
Dim sheet1 As String
Dim Sheet2 As String
Dim deleteIndex As Integer
Dim rowIndex As Integer

Sub Auto_Open()

    Dim yesterday As String
    Dim koumokuName As String
    Dim colIndex As Integer
    Dim maxCol As Integer
    Dim maxRow As Integer
    Dim downLoadFolderPath As String
    Dim fileName As String
    Dim tanshinPath As String
    Dim grothStockCellVal As String
    Dim oneStockCellVal As String
    Dim rowIndex As Integer
    Dim outPutBookName As String
    Dim outputRowIndex As Integer

    outPutBookName = "成長株検索.xlsm"
    sheet1 = "Sheet1"
    Sheet2 = "Sheet2"
    Workbooks(outPutBookName).Worksheets(sheet1).Range("9:200").ClearContents

    downLoadFolderPath = "{ダウンロードフォルダのパスを入力}"
    fileName = Dir(downLoadFolderPath & "*.xls")
    'ダウンロードフォルダのExcelを全削除
    If fileName <> "" Then
        Kill downLoadFolderPath & "*.xls"
    End If

    '決算短信一覧をダウンロード
    Call RunPython("sys.path.append(r'{呼び出すPythonファイルのパスを入力}'); import kessanTanshin; kessanTanshin.downLoadTanshin()")

    '決算短信ブックを開く
    fileName = Dir(downLoadFolderPath & "*.xls")
    tanshinPath = downLoadFolderPath & fileName
    Workbooks.Open tanshinPath

    bookName = fileName
    yesterday = Format(DateAdd("d", -1, Date), "yyyy/m/d")

    colIndex = 1
    koumokuName = "First"
    Do
        If koumokuName = "会計基準" Then
            Call colsDelete(colIndex, 2)
        ElseIf koumokuName = "経常利益" Then
            Call colsDelete(colIndex, 10)
        Else
            colIndex = colIndex + 1
       End If
       koumokuName = Workbooks(bookName).Worksheets(sheet1).Cells(1, colIndex).Value
    Loop While koumokuName <> "情報公開又は更新日"

    Workbooks(bookName).Worksheets(sheet1).Range("A1").AutoFilter Field:=colIndex, Criteria1:="=" & yesterday

    Workbooks(bookName).Worksheets(Sheet2).Range("A:N").Delete

    Workbooks(bookName).Worksheets(sheet1).UsedRange.Copy Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("A1")

    Workbooks(bookName).Worksheets(Sheet2).Columns("B").ColumnWidth = 35
    Workbooks(bookName).Worksheets(Sheet2).Columns("E").AutoFit
    Workbooks(bookName).Worksheets(Sheet2).Columns("F").AutoFit
    Workbooks(bookName).Worksheets(Sheet2).Columns("H").AutoFit
    Workbooks(bookName).Worksheets(Sheet2).Columns("I").AutoFit

    maxCol = Workbooks(bookName).Worksheets(Sheet2).Range("A1").End(xlToRight).Column
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 1).Value = "営業利益率"
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 2).Value = "増収率"
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 3).Value = "成長株"
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 4).Value = "一行のみ"

    On Error GoTo OnError

    maxRow = Workbooks(bookName).Worksheets(Sheet2).Range("A1").End(xlDown).Row
    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 1).Value = "=I2/H2"
    Workbooks(bookName).Worksheets(Sheet2).Range("K2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("K2:K" & maxRow)

    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 2).Value = "=(H2-H3)/H3"
    Workbooks(bookName).Worksheets(Sheet2).Range("L2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("L2:L" & maxRow)

    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 3).Value = "=IF(AND(K2>=0.1, L2>=0.2, A2=A3, A1<>A2),""GOOD"","""")"
    Workbooks(bookName).Worksheets(Sheet2).Range("M2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("M2:M" & maxRow)

    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 4).Value = "=IF(AND(A2<>A1,A2<>A3,K2>=0.1),"""","""")"
    Workbooks(bookName).Worksheets(Sheet2).Range("N2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("N2:N" & maxRow)

    '成長株と1行株のみ抽出
    outputRowIndex = 9
    For rowIndex = 1 To maxRow
        If Not IsError(Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 13).Value) And Not IsError(Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 14).Value) Then
            grothStockCellVal = Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 13).Value
            oneStockCellVal = Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 14).Value
            If grothStockCellVal = "GOOD" Then
                Workbooks(bookName).Worksheets(Sheet2).Range("A" & rowIndex & ":L" & rowIndex + 1).Copy
                Workbooks(outPutBookName).Worksheets(sheet1).Range("A" & outputRowIndex).PasteSpecial _
                                 Paste:=xlPasteValues, _
                                 Operation:=xlNone, _
                                 SkipBlanks:=False, _
                                 transpose:=False
                outputRowIndex = outputRowIndex + 2
            ElseIf oneStockCellVal = "〇" Then
                Workbooks(bookName).Worksheets(Sheet2).Range("A" & rowIndex & ":K" & rowIndex).Copy
                Workbooks(outPutBookName).Worksheets(sheet1).Range("A" & outputRowIndex).PasteSpecial _
                                 Paste:=xlPasteValues, _
                                 Operation:=xlNone, _
                                 SkipBlanks:=False, _
                                 transpose:=False
                outputRowIndex = outputRowIndex + 1
            End If
        End If
    Next

    Call Workbooks(bookName).Close(SaveChanges:=False)
    End
OnError:
    MsgBox yesterday + "の決算発表銘柄はありません"

    Call Workbooks(bookName).Close(SaveChanges:=False)
End Sub

Function colsDelete(colIndex As Integer, deleteCount As Integer)
    For deleteIndex = 1 To deleteCount
        Workbooks(bookName).Worksheets(sheet1).Columns(colIndex).Delete
    Next
End Function

前日成長株検索から呼び出すPythonファイル

kessanTanshin.py
from selenium import webdriver
import time
import os

def downLoadTanshin():

    # WebDriverを読み込む
    driver = webdriver.Chrome("{chromedriver.exeの絶対パスを入力}")

    # 要素が見つかるまで指定時間繰り返し探索するようになります。
    driver.implicitly_wait(5)  # 秒

    driver.get("http://ke.kabupro.jp/doc/down40.htm")
    link = driver.find_element_by_xpath("// *[ @ id = 'centercont'] / table / tbody / tr[3] / td / a[2]")
    link.click()

    #ダウンロード待ち
    fileName = link.get_attribute("href").split("/")[4]
    downloadFolder = "{ダウンロードフォルダのパスを入力}"
    fileFullPath = downloadFolder + fileName
    while not os.path.isfile(fileFullPath):
        time.sleep(1)

指定日成長株検索機能のマクロ

指定日成長株検索
Option Explicit

Dim bookName As String
Dim sheet1 As String
Dim Sheet2 As String
Dim deleteIndex As Integer
Dim rowIndex As Integer

Sub selectDateSearch()

    Dim yesterday As String
    Dim koumokuName As String
    Dim colIndex As Integer
    Dim maxCol As Integer
    Dim maxRow As Integer
    Dim downLoadFolderPath As String
    Dim fileName As String
    Dim tanshinPath As String
    Dim grothStockCellVal As String
    Dim oneStockCellVal As String
    Dim rowIndex As Integer
    Dim outPutBookName As String
    Dim outputRowIndex As Integer

    outPutBookName = "成長株検索.xlsm"
    sheet1 = "Sheet1"
    Sheet2 = "Sheet2"
    Workbooks(outPutBookName).Worksheets(sheet1).Range("9:200").ClearContents

    downLoadFolderPath = "{ダウンロードフォルダのパスを入力}"

    '決算短信ブックを開く
    fileName = Dir(downLoadFolderPath & "*.xls")
    tanshinPath = downLoadFolderPath & fileName
    Workbooks.Open tanshinPath

    bookName = fileName
    yesterday = InputBox(Prompt:="検索したい決算発表日を入力してください", default:=Format(DateAdd("d", -1, Date), "yyyy/m/d"))

    colIndex = 1
    koumokuName = "First"
    Do
        If koumokuName = "会計基準" Then
            Call colsDelete(colIndex, 2)
        ElseIf koumokuName = "経常利益" Then
            Call colsDelete(colIndex, 10)
        Else
            colIndex = colIndex + 1
       End If
       koumokuName = Workbooks(bookName).Worksheets(sheet1).Cells(1, colIndex).Value
    Loop While koumokuName <> "情報公開又は更新日"

    Workbooks(bookName).Worksheets(sheet1).Range("A1").AutoFilter Field:=colIndex, Criteria1:="=" & yesterday

    Workbooks(bookName).Worksheets(Sheet2).Range("A:N").Delete

    Workbooks(bookName).Worksheets(sheet1).UsedRange.Copy Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("A1")

    Workbooks(bookName).Worksheets(Sheet2).Columns("B").ColumnWidth = 35
    Workbooks(bookName).Worksheets(Sheet2).Columns("E").AutoFit
    Workbooks(bookName).Worksheets(Sheet2).Columns("F").AutoFit
    Workbooks(bookName).Worksheets(Sheet2).Columns("H").AutoFit
    Workbooks(bookName).Worksheets(Sheet2).Columns("I").AutoFit

    maxCol = Workbooks(bookName).Worksheets(Sheet2).Range("A1").End(xlToRight).Column
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 1).Value = "営業利益率"
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 2).Value = "増収率"
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 3).Value = "成長株"
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 4).Value = "一行のみ"

    On Error GoTo OnError

    maxRow = Workbooks(bookName).Worksheets(Sheet2).Range("A1").End(xlDown).Row
    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 1).Value = "=I2/H2"
    Workbooks(bookName).Worksheets(Sheet2).Range("K2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("K2:K" & maxRow)

    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 2).Value = "=(H2-H3)/H3"
    Workbooks(bookName).Worksheets(Sheet2).Range("L2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("L2:L" & maxRow)

    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 3).Value = "=IF(AND(K2>=0.1, L2>=0.2, A2=A3, A1<>A2),""GOOD"","""")"
    Workbooks(bookName).Worksheets(Sheet2).Range("M2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("M2:M" & maxRow)

    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 4).Value = "=IF(AND(A2<>A1,A2<>A3,K2>=0.1),"""","""")"
    Workbooks(bookName).Worksheets(Sheet2).Range("N2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("N2:N" & maxRow)

    '成長株と1行株のみ抽出
    outputRowIndex = 9
    For rowIndex = 1 To maxRow
        If Not IsError(Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 13).Value) And Not IsError(Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 14).Value) Then
            grothStockCellVal = Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 13).Value
            oneStockCellVal = Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 14).Value
            If grothStockCellVal = "GOOD" Then
                Workbooks(bookName).Worksheets(Sheet2).Range("A" & rowIndex & ":L" & rowIndex + 1).Copy
                Workbooks(outPutBookName).Worksheets(sheet1).Range("A" & outputRowIndex).PasteSpecial _
                                 Paste:=xlPasteValues, _
                                 Operation:=xlNone, _
                                 SkipBlanks:=False, _
                                 transpose:=False
                outputRowIndex = outputRowIndex + 2
            ElseIf oneStockCellVal = "〇" Then
                Workbooks(bookName).Worksheets(Sheet2).Range("A" & rowIndex & ":K" & rowIndex).Copy
                Workbooks(outPutBookName).Worksheets(sheet1).Range("A" & outputRowIndex).PasteSpecial _
                                 Paste:=xlPasteValues, _
                                 Operation:=xlNone, _
                                 SkipBlanks:=False, _
                                 transpose:=False
                outputRowIndex = outputRowIndex + 1
            End If
        End If
    Next

    Call Workbooks(bookName).Close(SaveChanges:=False)
    End
OnError:
    MsgBox yesterday + "の決算発表銘柄はありません"

    Call Workbooks(bookName).Close(SaveChanges:=False)
End Sub

Function colsDelete(colIndex As Integer, deleteCount As Integer)    
    For deleteIndex = 1 To deleteCount
        Workbooks(bookName).Worksheets(sheet1).Columns(colIndex).Delete
    Next
End Function

4. 各処理の解説

順を追って各処理の内容を解説していきます。

成長株検索マクロExcel起動時に自動で流れる処理(前日成長株検索)

VBAはSubプロシージャの名前をAuto_OpenとするとExcel起動時に自動で実行されます。なので、前日成長株検索機能はAuto_Openの中に処理を書きました。

Sub Auto_Open()
    'ここに書いた処理がExcel起動時自動実行される
End Sub

まず、ダウンロードフォルダの中のExcelファイル(拡張子が*.xlsのもの)を削除します。これからダウンロードする決算短信ブックをマクロで呼び出す際に特定しやすくするためです。

前日成長株検索
    downLoadFolderPath = "{ダウンロードフォルダのパスを入力}"
    fileName = Dir(downLoadFolderPath & "*.xls")
    'ダウンロードフォルダのExcelを全削除
    If fileName <> "" Then
        Kill downLoadFolderPath & "*.xls"
    End If

その後、決算短信ブックをダウンロードするPythonファイル(kessanTanshin.py)を呼び出します。

前日成長株検索
    '決算短信一覧をダウンロード
    Call RunPython("sys.path.append(r'{呼び出すPythonファイルの絶対パスを入力}'); import kessanTanshin; kessanTanshin.downLoadTanshin()")

ここからはPythonスクレイピングで決算短信ブックをダウンロードしてくる処理について説明していきます。

まず、決算プロというサイトにアクセス。

kessanTanshin.py
     # WebDriverを読み込む
    driver = webdriver.Chrome("{chromedriver.exeの絶対パスを入力}")

    # 要素が見つかるまで指定時間繰り返し探索するようになります。
    driver.implicitly_wait(5)  # 秒

    driver.get("http://ke.kabupro.jp/doc/down40.htm")

決算プロにアクセスしたら決算短信ブックをダウンロードするリンクを押下します。

kessanTanshin.py
    link = driver.find_element_by_xpath("// *[ @ id = 'centercont'] / table / tbody / tr[3] / td / a[2]")
    link.click()

決算プロのダウンロードリンク.jpg

リンク押下後、ダウンロード完了までループ処理で待ちます。

kessanTanshin.py
    #ダウンロード待ち
    fileName = link.get_attribute("href").split("/")[4]
    downloadFolder = "{ダウンロードフォルダのパスを入力}"
    fileFullPath = downloadFolder + fileName
    while not os.path.isfile(fileFullPath):
        time.sleep(1)

ダウンロードが完了するとマクロに処理が戻ります。

まず、ダウンロードフォルダに入っている決算短信ブックを開きます。

前日成長株検索
    '決算短信ブックを開く
    fileName = Dir(downLoadFolderPath & "*.xls")
    '決算短信ブックを開く
    fileName = Dir(downLoadFolderPath & "*.xls")
    tanshinPath = downLoadFolderPath & fileName
    Workbooks.Open tanshinPath tanshinPath = downLoadFolderPath & fileName
    Workbooks.Open tanshinPath

決算短信ブックから「会計基準」「連結個別」「経常利益」~「財務キャッシュフロー」の列を削除します。後ほど決算短信ブックのsheet1からsheet2へ必要なデータだけをコピーしてExcelのフィルター機能を使うための前準備です。
不要な列を削除.jpg

前日成長株検索
    colIndex = 1
    koumokuName = "First"
    Do
        If koumokuName = "会計基準" Then
            Call colsDelete(colIndex, 2)
        ElseIf koumokuName = "経常利益" Then
            Call colsDelete(colIndex, 10)
        Else
            colIndex = colIndex + 1
       End If
       koumokuName = Workbooks(bookName).Worksheets(sheet1).Cells(1, colIndex).Value
    Loop While koumokuName <> "情報公開又は更新日"

列削除の処理で呼び出しているcolsDelete関数の処理内容は以下です。

前日成長株検索
Function colsDelete(colIndex As Integer, deleteCount As Integer)
    For deleteIndex = 1 To deleteCount
        Workbooks(bookName).Worksheets(sheet1).Columns(colIndex).Delete
    Next
End Function

決算短信ブックのsheet1のデータをExcelのフィルター機能を使って「情報公開又は更新日」が前日のものだけに絞り込みます。それからsheet2のA~N列を削除し、sheet1からsheet2へ絞り込んだ全データをコピーします。

前日成長株検索
    Workbooks(bookName).Worksheets(sheet1).Range("A1").AutoFilter Field:=colIndex, Criteria1:="=" & yesterday

    Workbooks(bookName).Worksheets(Sheet2).Range("A:N").Delete

    Workbooks(bookName).Worksheets(sheet1).UsedRange.Copy Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("A1")

sheet2の1行目の一番右の列番号を取得。その列番号を1ずつ増加させ、1行目の右端に「営業利益率」「増収率」「成長株」「一行のみ」と追記していきます。

前日成長株検索
    maxCol = Workbooks(bookName).Worksheets(Sheet2).Range("A1").End(xlToRight).Column
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 1).Value = "営業利益率"
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 2).Value = "増収率"
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 3).Value = "成長株"
    Workbooks(bookName).Worksheets(Sheet2).Cells(1, maxCol + 4).Value = "一行のみ"

冒頭に記載した成長株の条件に当てはまる銘柄が1つもない場合、以降の処理でエラーが発生します。なのでここでエラーハンドリング処理を入れておきます。エラーが発生した場合は「{前日の日付}の決算発表銘柄はありません」というメッセージボックスが表示され、決算短信ブックを閉じます。

前日成長株検索
    On Error GoTo OnError
    'エラーが発生する可能性がある処理
OnError:
    MsgBox yesterday + "の決算発表銘柄はありません"

    Call Workbooks(bookName).Close(SaveChanges:=False)

決算短信ブックのsheet2の2行目の値を使い、「営業利益率」「増収率」「成長株」「一行のみ」の値を計算していきます。「成長株」「一行のみ」の条件は以下です。

  • 成長株 = 営業利益率0.1以上かつ増収率(売上高成長率)0.2以上
  • 一行のみ = 営業利益率0.1以上かつ決算データが最新年分しかないデータ

2行目のデータに対して上記の値をそれぞれ計算後、Excelのオートフィル機能を使って全行に同じ計算式を適用しています。

前日成長株検索
maxRow = Workbooks(bookName).Worksheets(Sheet2).Range("A1").End(xlDown).Row
    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 1).Value = "=I2/H2"
    Workbooks(bookName).Worksheets(Sheet2).Range("K2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("K2:K" & maxRow)

    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 2).Value = "=(H2-H3)/H3"
    Workbooks(bookName).Worksheets(Sheet2).Range("L2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("L2:L" & maxRow)

    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 3).Value = "=IF(AND(K2>=0.1, L2>=0.2, A2=A3, A1<>A2),""GOOD"","""")"
    Workbooks(bookName).Worksheets(Sheet2).Range("M2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("M2:M" & maxRow)

    Workbooks(bookName).Worksheets(Sheet2).Cells(2, maxCol + 4).Value = "=IF(AND(A2<>A1,A2<>A3,K2>=0.1),"""","""")"
    Workbooks(bookName).Worksheets(Sheet2).Range("N2").AutoFill Destination:=Workbooks(bookName).Worksheets(Sheet2).Range("N2:N" & maxRow)

最後に「成長株」または「一行のみ」のいずれかの条件にあてはまるデータを成長株検索マクロのブックにコピーし、決算短信ブックを閉じて処理終了です。

前日成長株検索
    '成長株と1行株のみ抽出
    outputRowIndex = 9
    For rowIndex = 1 To maxRow
        If Not IsError(Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 13).Value) And Not IsError(Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 14).Value) Then
            grothStockCellVal = Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 13).Value
            oneStockCellVal = Workbooks(bookName).Worksheets(Sheet2).Cells(rowIndex, 14).Value
            If grothStockCellVal = "GOOD" Then
                Workbooks(bookName).Worksheets(Sheet2).Range("A" & rowIndex & ":L" & rowIndex + 1).Copy
                Workbooks(outPutBookName).Worksheets(sheet1).Range("A" & outputRowIndex).PasteSpecial _
                                 Paste:=xlPasteValues, _
                                 Operation:=xlNone, _
                                 SkipBlanks:=False, _
                                 transpose:=False
                outputRowIndex = outputRowIndex + 2
            ElseIf oneStockCellVal = "〇" Then
                Workbooks(bookName).Worksheets(Sheet2).Range("A" & rowIndex & ":K" & rowIndex).Copy
                Workbooks(outPutBookName).Worksheets(sheet1).Range("A" & outputRowIndex).PasteSpecial _
                                 Paste:=xlPasteValues, _
                                 Operation:=xlNone, _
                                 SkipBlanks:=False, _
                                 transpose:=False
                outputRowIndex = outputRowIndex + 1
            End If
        End If
    Next

    Call Workbooks(bookName).Close(SaveChanges:=False)

指定日検索ボタン押下で流れる処理(指定日成長株検索)

こちらは以下のコードで入力ボックスを表示します。そして決算短信ブックのデータを、「情報公開又は更新日」が入力された日付と一致するものだけに絞り込みます。決算短信ブックは既にダウンロードフォルダにあるものを使います。それ以外の処理は前日成長株検索モジュールと同じなので省略。

前日成長株検索
    today = InputBox(Prompt:="検索したい決算発表日を入力してください", default:=Format(DateAdd("d", -1, Date), "yyyy/m/d"))

ご意見やご質問もTwitterにご連絡いただけると気づきやすいのでよろしくお願いします。

9
18
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
9
18