覚えておくと便利（エクセル、VBA）

エクセル　50%の確率で1か0をランダムで出してくれる

=MOD(ROUND(RAND()*10+10,0),2)

VBAでバッチを動かす（Sylpheedを宛先＆件名付きで起動）

'参照設定：Windows Script Hpst Object Model

Sub mail(subject As String)

'コマンドプロンプトを使うためのオブジェクト
Dim wsh As New IWshRuntimeLibrary.WshShell
'コマンド結果を格納する変数
Dim result As WshExec

Dim cmd As String
Dim filedata() As String
Dim i As Integer

m_ddress = Format(Cells(1, 2), "0000") & "@co.jp"
m_subject = subject

'実行したいコマンド
cmd = " ""C:¥Program Files (x86)¥Sylpheed¥sylpheed.exe"" --compose " & m_ddress & "?subject=" & m_subject

Debug.Print cmd

'コマンドを実行
wsh.Run "%ComSpec% /c " & cmd
'コマンドの実行が終わるまで待機
'Do While result.Status = 0
' DoEvents
'Loop

'MsgBox (result.StdOut.ReadAll)

'結果を改行区切りで配列へ格納
'filedata = Split(result.StdOut.ReadAll, vbCrLf)

'A1から順番に結果を書き込む
'For Each filenm In filedata
'Next

Set result = Nothing
Set wsh = Nothing

End Sub

エクセル　VBA　３列目のセルが変わったら、１行文の色を変える

Sub cellchange(Target)
With Target
Select Case .Column
Case 3:
Call row_color_change(Target)
ActiveWorkbook.Save
End Select
End With

End Sub

Sub row_color_change(Target)

Dim fname As String
Dim frow As Integer
Dim i As Integer
Dim bgcolor As Variant
Dim txcolor As Variant

'現在のシート名を取得
'fname = ActiveSheet.Name

'・行数を取得
frow = Target.Row

'・変わったセルとカテゴリの文字を照合して
i = 1
With ThisWorkbook.Worksheets("カテゴリ")
ctg = .Cells(i, 1)
Do While ctg <> ""
'◆カテゴリ名が同じだったら
If Target = ctg Then
'背景色を取得
bgcolor = .Cells(i, 1).Interior.Color
'文字色を取得
txcolor = .Cells(i, 1).Font.Color
End If
i = i + 1
ctg = .Cells(i, 1)
Loop
End With

'Worksheets(fname).Activate

'背景色が白だったら、初期化する
If bgcolor = 16777215 Then
Range(Cells(frow, 1), Cells(frow, 7)).Interior.ColorIndex = 0
'白以外だったら行数の背景色を変更する
Else
Range(Cells(frow, 1), Cells(frow, 7)).Interior.Color = bgcolor
End If

'文字色を変える
Range(Cells(frow, 1), Cells(frow, 7)).Font.Color = txcolor

End Sub

VBA　入力フォーム

[昨日]　[今日]　[明日]　　[ yyyy/m/d(aaa)[▼]　[挿入]

┌─────────────────────────┐

│　　　　　　　　　　　　　　　　　　　　　　　　　│

└─────────────────────────┘

[改行]　　　　　　　　　　　　　　　　　　　　　[OK]

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'フォームを読み込んだら

Private Sub UserForm_Initialize()

'dlist.Value = Format(Now(), "yyyy/m/d(aaa)")

befor = 7

For i = 0 To 32 + befor

dlist.AddItem ""

dlist.List(i, 0) = ""

dlist.List(i, 1) = Format(Now() + i - befor, "yyyy/m/d(aaa)")

Select Case Now() + i - befor

Case Now():

dlist.List(i, 0) = "今日"

Case Now() + 7:

dlist.List(i, 0) = "来週"

Case Now() - 7:

dlist.List(i, 0) = "先週"

Case DateAdd("m", 1, Now()):

dlist.List(i, 0) = "来月"

End Select

Next i

dlist.ColumnWidths = 30

dlist.TextColumn = 2

dlist.ListIndex = befor

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'昨日を押したら

Private Sub yday_Click()

InsertText (day_cal(-1) & "　")

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'今日を押したら

Private Sub tday_Click()

InsertText (day_cal(0) & "　")

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'明日を押したら

Private Sub tmday_Click()

InsertText (day_cal(1) & "　")

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'日付の計算

Function day_cal(num)

day_cal = Format(Now() + num, "yyyy/m/d")

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'挿入を押したら

Private Sub CommandButton1_Click()

InsertText (Format(dlist.Value, "yyyy/m/d") & "　")

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'改行を押したら

Private Sub kaigyo_Click()

InsertText (vbCrLf)

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'OKを押したら

Private Sub SaveBtn_Click()

ActiveCell.Value = TextBox

Call ActibeClear(ActiveCell)

Unload Me

End Sub