損益計算書
利用例 | Excel感覚で操作できるメシウスのkintoneプラグイン「krew」
利用例 | Excel感覚で操作できるメシウスのkintoneプラグイン「krew」
１アプリで予実管理を行う（簡易予実）
利用例 | Excel感覚で操作できるメシウスのkintoneプラグイン「krew」
■
' 画面更新を停止
Application.ScreenUpdating = False
' フィルター解除
リストシート.AutoFilterMode = False
' リストシートのB列の最終行を取得
最終行 = リストシート.Cells(Rows.Count, "B").End(xlUp).Row
' フィルターを設定
With リストシート.Range("B1:B" & 最終行)
.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, Format(抽出日付, "m/d/yyyy"))
End With
' リストシートのB列の最終行を更新
最終行 = リストシート.Cells(Rows.Count, "B").End(xlUp).Row
' リストシートをアクティブにする
リストシート.Activate
' 新しいブックにリストシートをコピーして保存
Set 新しいブック = Workbooks.Add
Set 新しいシート = 新しいブック.Sheets(1)
' コピーしてすべて貼り付け
リストシート.Range("A1:I" & 最終行).Copy
新しいシート.Range("A1").PasteSpecial xlPasteAll
' A列からD列をコピーして値だけを貼り付け
リストシート.Range("A1:D" & 最終行).Copy
新しいシート.Range("A1").PasteSpecial Paste:=xlPasteValues
' 画面更新を再開
Application.ScreenUpdating = True
フィルター実行
Sub フィルター実行()
Dim 抽出シート As Worksheet
Dim リストシート As Worksheet
Dim 抽出日付 As Variant
Dim 最終行 As Long
Dim 新しいブック As Workbook
Dim 新しいシート As Worksheet
Dim 保存パス As String
' シートの取得
Set 抽出シート = Worksheets("抽出") ' 抽出シートに変更
Set リストシート = Worksheets("リスト")
' 抽出シートのB1セルから日付を取得
抽出日付 = 抽出シート.Range("B1").Value ' 抽出日付に変更
' 日付が入力されているか確認
If Not IsDate(抽出日付) Then
MsgBox "日付が無効です。"
Exit Sub
End If
' リストシートのB列の最終行を取得
最終行 = リストシート.Cells(Rows.Count, "B").End(xlUp).Row
' フィルター解除
リストシート.AutoFilterMode = False
' フィルターを設定
With リストシート.Range("B1:B" & 最終行)
.AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, Format(抽出日付, "m/d/yyyy"))
End With
' リストシートをアクティブにする
リストシート.Activate
' 新しいブックにリストシートをコピーして保存
Set 新しいブック = Workbooks.Add
Set 新しいシート = 新しいブック.Sheets(1)
' A列からD列をコピーして書式と値を貼り付け
リストシート.Range("A:D").Copy
新しいシート.Range("A1").PasteSpecial Paste:=xlPasteFormats
' A列からD列をコピーして値だけを貼り付け
リストシート.Range("A:D").Copy
新しいシート.Range("A1").PasteSpecial Paste:=xlPasteValues
' D列からI列をコピーしてそのまま貼り付け
リストシート.Range("E:I").Copy
新しいシート.Range("E1").PasteSpecial xlPasteAll
' 貼り付け後にクリップボードをクリア
Application.CutCopyMode = False
新しいシート.Range("A1").Select
MsgBox "抽出が完了しました"
' ' 保存パスをダウンロードフォルダに設定（適切なフォルダを指定してください）
' 保存パス = Environ("USERPROFILE") & "\Downloads\新しいブック名.xlsx"
'
' ' 新しいブックを保存
' 新しいブック.SaveAs 保存パス ' 保存パスを適切なパスに変更
' 新しいブック.Close SaveChanges:=False
End Sub
Excel
=IFNA(VLOOKUP(B2,A[[#すべて],[A]:[C]],2,FALSE),VLOOKUP(B2,リスト!A1:E3,2,FALSE))
=("24:00"-E3)+F2
Columnl Column2 Column3
1 0 3
4 0 6
10 0 10
2024/01/22
Sub ファイル名チェックとメール送信()
Dim folderPath As String
Dim fileList As New Collection
Dim fileName As String
Dim wsFileCheck As Worksheet
Dim wsList As Worksheet
Dim outlookApp As Object
Dim mailItem As Object
Dim invalidFileNames As String
Dim invalidFileNameCount As Integer
' 本Excelのフォルダパスを取得
folderPath = ThisWorkbook.Path & "\"
' 「ファイルチェック」シートと「リスト」シートを取得
Set wsFileCheck = ThisWorkbook.Sheets("ファイルチェック")
Set wsList = ThisWorkbook.Sheets("リスト")
' 指定したパターンのファイルを検索
fileName = Dir(folderPath & "*.pdf")
' 初期化
invalidFileNames = ""
invalidFileNameCount = 0
' ファイルの数だけ繰り返し
Do While fileName <> ""
' ファイル名に「】」が含まれていない場合
If InStr(fileName, "】") = 0 Then
' ファイル名を記録
invalidFileNames = invalidFileNames & fileName & vbCrLf
invalidFileNameCount = invalidFileNameCount + 1
End If
' 次のファイルを取得
fileName = Dir
Loop
' ファイル名に「】」が含まれていないファイルが存在する場合
If invalidFileNameCount > 0 Then
' 警告メッセージを表示
MsgBox invalidFileNameCount & "件のファイル名に「】」が含まれていません。以下のファイルが列挙されます:" & vbCrLf & invalidFileNames, vbExclamation
End If
' 「リスト」シートのA列が0の行を検索し、対応するD列のメールアドレスにメールを送信
For i = 1 To wsList.Cells(wsList.Rows.Count, 1).End(xlUp).Row
If wsList.Cells(i, 1).Value = 0 Then
' Outlookの設定を確認
On Error Resume Next
Set outlookApp = GetObject(, "Outlook.Application")
On Error GoTo 0
' Outlookが起動していない場合は新規に起動
If outlookApp Is Nothing Then
Set outlookApp = CreateObject("Outlook.Application")
End If
' メールアイテムを作成
Set mailItem = outlookApp.CreateItem(0)
' メール送信画面を表示
With mailItem
.To = wsList.Cells(i, 4).Value ' D列のメールアドレスを指定
.Subject = wsList.Cells(i, 5).Value ' E列のサブジェクトを指定
.Body = wsList.Cells(i, 6).Value ' F列のメール本文を指定
.Display ' メール送信画面を表示
End With
Set outlookApp = Nothing
Set mailItem = Nothing
End If
Next i
End Sub
