シート保護掛けたが、パスワードを忘れてしまいました？ハッキング方法

下記のソースコードを解除したいシートにコピーして、実行するだけ…

Sub PasswordBreaker()
Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox "One usable password is " & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub

ここ参照

vlookupではできない、範囲指定のカスタマイズ関数

Function vlookups(val As Range, min As Range, max As Range, col As Range) As String
Dim cl As Range
For Each cl In min
    If val.Value >= cl.Value And val.Value <= cl.Worksheet.Cells(cl.Row, max.Column) Then
        vlookups = cl.Worksheet.Cells(cl.Row, col.Column)
        Exit For
    End If
Next
End Function

使い方： =vlookups(E4,$A$1:$A$4,$B$1:$B$4,$C$1:$C$4) 結果：

令和数式を置換してくれる自作関数

ポイントは正規表現のReplaceで、パターン化して一致されたセルの番地を更にReplaceに使ったこと。「$1」を使って一個目のマッチングを引用すること。

Option Explicit
Public Const REIWA = "IF(_CELL_>=DATE(2019,5,1),""令和""&IF(YEAR(_CELL_)-2018=1,""元"",YEAR(_CELL_)-2018)&""年""&MONTH(_CELL_)&""月""&DAY(_CELL_)&""日"",TEXT(_CELL_,""ggge年m月d日""))"
Function reiwa_switch(strFormual, strCellAddr As String) As String

Dim reg As Object
Set reg = CreateObject("VBScript.RegExp")
With reg
    .Pattern = "TEXT\((" & strCellAddr & "),""ggge年m月d日""\)"
    .IgnoreCase = False
    .Global = True
End With
reiwa_switch = reg.Replace(strFormual, Replace(REIWA, "_CELL_", "$1"))
End Function


=reiwa_switch(A1,A2)→関数


TEXT(data!FU3,"ggge年m月d日")→第一引数（A1）
data!FU3→第二引数（A2）
IF(data!FU3>=DATE(2019,5,1),"令和"&IF(YEAR(data!FU3)-2018=1,"元",YEAR(data!FU3)-2018)&"年"&MONTH(data!FU3)&"月"&DAY(data!FU3)&"日",TEXT(data!FU3,"ggge年m月d日"))→結果


【新年号】令和元年、エクセル数式での対応方法


=IF(D1>=DATE(2019,5,1),"令和"&IF(YEAR(D1)-2018=1,"元",YEAR(D1)-2018)&"年"&MONTH(D1)&"月"&DAY(D1)&"日",TEXT(D1,"ggge年m月d日"))

※数式の中の「D1」は実際日付が書いてあるセルです、そこは適当に変更してください。
※「令和元年」ではなく「令和1年」として表示したければ、「IF(YEAR(D1)-2018=1,"元",」を削除し、「-2018)&"年"」の中の「)」も削除すればOK

文字列の数字をサマリー Sum string number

数字なんだけど、文字列として表示せざるを得ない場合もある。その場合、この一列の数字を「SUM」するとうまくいかない場合があるみたい。AB4:AB100をサマリーする場合、
ソリューションとして「=VALUE(AB4)」の補助列を追加することは考えられますが、「=SUMPRODUCT(AB4:AB100 *1)」という方法もできるみたいです。

列の値を一括更新（LOOP、Query、補助列を使わず！）

列の値を一括更新するときは、vbaで行ごとLOOPを書くか、ADODBでUpdateクエリーを書くか、補助列を挿入して数式で計算させるかでも、最近「Evaluate」知ったですよ

Range("B:B").Value = Evaluate(Range("B:B").Address & "*10")

これは神メソッドですね。気を付けなければならないのは、空欄が0に評価されてしまう、数字以外の文字列がエラーになる。

メソッド化にすると

Sub updateRangeValues(ByRef rg As Range, strFormula As String, Optional strFormat As String = "")
    rg.Worksheet.Activate '←ここが重要！！、なぜかこうしないと全部0と評価してしまう
    If strFormat <> "" Then
        rg.NumberFormatLocal = strFormat
    End If
    rg.Value = Application.Evaluate(rg.Address & strFormula)
    Application.Calculate
    Do While Application.CalculationState <> xlDone '←念のため、計算が終わまでDoEvents
        DoEvents
    Loop
End Sub

使い方：

Call updateRangeValues(Range("A1:A1000"),"*10.1","#.00")

LOOP、Query、補助列を使わずに、"A1:A1000"列の数値を全部＊10.1,書式を小数点二桁にする


もう少し複雑な数式でもいけるらしい

Sub nn()
Dim rg As Range
Set rg = ThisWorkbook.Worksheets(1).Range("C1:C36")
strFormula = "=IF(" & rg.Address & "= """",""IS EMPTY""," & rg.Address & "*10)"
rg.Value = Application.Evaluate(strFormula)
End Sub

特定の列に値が入ってれば、条件付き書式で行ごとを塗りつぶす

エクセルの条件付き書式なかなかわかりづらい。なのでメモ残す。

やりたいこと：
B列からF列まで、一つでも値が入ってれば、B列からJ列まで全部塗りつぶす。


手順：
１．最初の行（5行目）のB列からJ列を選択し、メニューから「条件付き書式」→「新しいルール」をクリック、

２．図のように、「数式を使用して、書式設定するセルを決定」を選択し、数式を入れます：

=COUNTA($B5:$F5)>0

※最初の「=」は省略できません、「COUNTA」は値が入っているセルの数を統計する、「B」と「F」の左に「$」が付いているのは、列は絶対参照するということです、「5」はその時の行番号です、複数行にこの条件付き書式を適用したいので、「5」の左には「$」を付けないです。
３．そして、塗りつぶしの書式を設定して、OKを押す。
４．最後、「B5:J5」を選択したまま、メニューから「条件付き書式」→「ルールの管理」をクリック、「適用先」は「=$B$5:$J:$5」になっていると思いますが、それを「=$B$5:$J:$33」に変えて「OK」を押す。

５．そうすると、ゴールの「B列からF列まで、一つでも値が入ってれば、B列からJ列まで全部塗りつぶす。」が達成できます。

エクセルで右クリックが効かないときの対策

エクセルで右クリックが効かないときの対策
①エクセルを開いて
②Alt + F11押してVBEを出します
③Ctrl+Gでイミディエイトを出します
④下記をコピペして、Enterを押す

Application.CommandBars("cell").Enabled = True

⑤Alt+Qでシートに戻る

シートタブの右クリックが無効になった場合の対策
方法はほぼ同じ、④番のコピペが下記に変更するだけ

Application.CommandBars("Ply").Enabled = True


エクセルの入力規則の数式を使って複雑な制限を実現する例

エクセルの入力規則の数式を使って複雑な制限を実現する例です：
例えばA1セルで以下の入力を許可する：

①整数数字の入力（例）123
②整数数字-整数数字（例）123-456

以下やり方：
１．まず、「1-1」を入力すると「1月1日」とエクセルが余計のことをするので、まずセルを「文字列」にしましょう

２．数字を許す→データ→入力規則→ユーザー設定→数式：
　　条件①整数数字の入力について、本来なら数式に「=ISNUMBER(A1)」で話は済んだが、こちら「文字列」にしたせいで、ISNUMBERは常にFALSE
　　解決方法は「=NOT(ISERROR(INT(A1)))」を使います。

３．また、条件②整数数字-整数数字を追加すると、数式が一気に複雑になります
　　「=OR(NOT(ISERROR(INT(A1))),AND(NOT(ISERROR(FIND("-",A1))),NOT(ISERROR(INT(MID(A1,1,FIND("-",A1)-1)))),NOT(ISERROR(INT(MID(A1,FIND("-",A1)+1,LEN(A1)))))))」

注意！！数式が複雑すぎで、長すぎで入れなくなってしまう可能性があります！！　↓↓↓
「A1」を自己参照の「INDIRECT(ADDRESS(ROW(),COLUMN()))」に変換しようとしたら、数式を長すぎで入れなくなってしまった…
　　

Excel数値の書式について


"*"(#,###);[赤]#,###;#,###

  11000 → *(11,000)
 -11000 → -11,000
         0 →


プラスのとき;マイナスの時;ゼロの時

ゼロの時は「#,##」でも何も表示されないので結構です。
そんな感じ

「データ入力規則」についてExcel2010と2007の互換性

現象：

「データ入力規則」が消えた！？

1. Excel2010で作ったシートに、「データ入力規則」で別シートのセルを参照した
2. Excel2003又はExcel2007で開いたら、ドロップダウンリストが消えました
3. しかも「データ入力規則」で別シートのセルを参照し直そうとすると、電子レンジが「チン～！」
4. 「え？！これもしかして互換性？2010と2007にそんな差があったとは思わなかった」

解決方法：

1. 別シート参照したいセル（範囲）に名前を付けて
2. 「データ入力規則」で「リスト」を選択して、「元の値」で「F3」
3. 定義済みの名前を選択

MSって馬鹿だね...

switch all comments show/hide by dblClick a cell

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$1" Then
        If Target.Value = "on" Then
            Target.Value = ""
            Application.DisplayCommentIndicator = xlCommentIndicatorOnly
        Else
            Application.DisplayCommentIndicator = xlCommentAndIndicator
            Target.Value = "on"
        End If
        Cancel = True
    End If
End Sub

ExcelのDATE関数で「日」で「ゼロ」を入れると、前月の最終日が帰ってくる

Excelの数式「=DATE(年,月,日)」の「日」で「ゼロ」を入れると、前月の最終日が帰ってくる

=DATE(2013,2,0)

値は 2013/1/31で帰ってくる
え？裏ワザ？

vba条件書式の罠

現象：vbaで条件書式を追加したら、訳がわからない条件が追加される、Excel2007
下のコードで「C1」セルに、自分自身がエラーの場合、背景色を変える条件書式を追加したところ

Sub test()
    Sheet1.Range("C1").FormatConditions.Delete
    Sheet1.Range("C1").FormatConditions.Add Type:=xlExpression, Formula1:="=ISERROR(C1)"
    Sheet1.Range("C1").FormatConditions(1).Interior.ColorIndex = 38
End Sub

実行後、出来た数式を見てみると、なんだこりゃ～？！「ISERROR(C1)」と指定したのに、「XFD1」とはなんだ？！！

試しに絶対参照の「ISERROR($C$1)」にしてみたら、治った（当たり前だ）。でも絶対参照だとソートとかしたら大変なことになるので...
まぁ、最後はこうして治ったけど、なんか腑に落ちないな～

Sub test()
    Sheet1.Activate
    Sheet1.Range("C1").Select
    Sheet1.Range("C1").FormatConditions.Delete
    Sheet1.Range("C1").FormatConditions.Add Type:=xlExpression, Formula1:="=ISERROR(C1)"
    Sheet1.Range("C1").FormatConditions(1).Interior.ColorIndex = 38
End Sub

excelの数値format

内容	指定文字	例
表示する桁数を指定する。"0"1つで1桁を表し、それより桁数が少ない数値の場合は"0"で埋められる。	0	Format(12345,"0000000") → 0012345 Format(12345,"000") → 12345
表示する桁数を指定する。"#"1つで1桁を表し、それより桁数が少ない数値の場合は元の数値がそのまま返される。	#	Format(12345,"#######") → 12345 Format(12345,"###") → 12345
0や"#"と組み合わせて小数点の位置を指定する。	.	Format(12345.567,"0000000.00") → 0012345.57 Format(12345.567,"0000000.00000") → 0012345.56700 Format(12345.567,"#######.##") → 12345.57 Format(12345.567,"#.#####") → 12345.567
0や"#"と組み合わせて1000ごとにカンマで区切る。	,	Format(12345,"0,000,000") → 0,012,345 Format(12345,"#,###") → 12,345
数値を100倍してパーセント表示する。	%	Format(0.25,"#%") → 25%
数値の先頭に￥マークを付ける。	\\	Format(12345,"\\#,###") → \12,345
このマークのすぐ後1文字をそのまま表示する。	\	Format(12345,"\@#,###") → @12,345 Format(12345.56,"0.000\円/\ケ") → 12345.560円/ケ
ダブルクォーテーションで囲まれた文字列はそのまま表示する。		Format(12345,"#,###""です""") → 12,345です

エクセルでデータベースを参照するサンプル、SQL ServerとmySQL対応

シート1の名前を「"テーブル一覧"」にして、ボタンを追加する
そして、I列の1から5行目、下記の情報を入れる
サーバー
DB名
ユーザ
パスワード
接続DBタイプ["SQL Server","MySQL ODBC 5.1 DRIVER"]
※今のところ、MS SQL Serverとmysqlしか対応していない
シート"テーブル一覧"は

Private Sub CommandButton1_Click()
 Call getTables
End Sub

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    'MsgBox Target.TextToDisplay
    getTableData Target.TextToDisplay
End Sub

モジュールに下記のコード

Public con As ADODB.Connection
Public wb As Workbook
Public st As Worksheet
Public gDB As String
Public gConDriver As String
Dim connectionString As String


Sub initDBcon()


Set wb = ThisWorkbook
Set st = wb.Worksheets("テーブル一覧")
'接続文字列
gConDriver = st.Range("I5")


Select Case gConDriver
    Case "SQL Server"
        connectionString = "Provider=Sqloledb;" _
                & " Data Source=" & st.Range("I1") & ";" _
                & " Initial Catalog=" & st.Range("I2") & ";" _
                & " Connect Timeout=15;" _
                & " user id=" & st.Range("I3") & ";" _
                & " password=" & st.Range("I4")
    Case "MySQL ODBC 5.1 DRIVER"
        connectionString = "Driver={" & gConDriver & "};" _
                & " SERVER=" & st.Range("I1") & ";" _
                & " DATABASE=" & st.Range("I2") & ";" _
                & " USER=" & st.Range("I3") & ";" _
                & " PASSWORD=" & st.Range("I4") & ";"
End Select

gDB = st.Range("I2")

'ADODB.Connection生成
Set con = New ADODB.Connection
On Error GoTo Err

'MySQLに接続
con.Open connectionString
Exit Sub
Err:
    Set con = Nothing
    MsgBox (Err.Description)

End Sub
Sub getTables()

Dim rs As ADODB.Recordset


Dim sqlStr As String

Dim rowNo As Integer
Dim colNo As Integer
Dim item As Variant


Call initDBcon
If con Is Nothing Then
    Exit Sub
End If
Application.DisplayAlerts = False
For Each stname In wb.Sheets
    If stname.Name <> "テーブル一覧" Then
        stname.Delete
    End If
Next
Application.DisplayAlerts = True

'SQL文
Select Case gConDriver
    Case "SQL Server"
        sqlStr = "select table_name from information_schema.tables;"
    Case "MySQL ODBC 5.1 DRIVER"
        sqlStr = "show tables;"
End Select


'SQL文実行
Set rs = con.Execute(sqlStr)

'シートデータクリア
'st.Cells.Clear
st.Columns("A:A").Clear
rowNo = 1
Do While rs.EOF = False
    'データ抽出
    For Each item In rs.Fields
        st.Range("A" & rowNo).Value = item.Value
        st.Range("A" & rowNo).Hyperlinks.Add Anchor:=st.Range("A" & rowNo), _
        Address:="", TextToDisplay:=item.Value
    Next
    rowNo = rowNo + 1
    '次のレコード
    rs.MoveNext
Loop

'クローズ
con.Close
Set rs = Nothing
Set con = Nothing

Exit Sub


End Sub

Sub getTableData(ByVal srtTableName As String)
Dim stname As Variant
Dim qt As QueryTable

Call initDBcon
    For Each stname In wb.Sheets
        If stname.Name = srtTableName Then
            Exit Sub
        End If
    Next
    wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)).Name = srtTableName
    
On Error GoTo Err
Select Case gConDriver
Case "MySQL ODBC 5.1 DRIVER"
    With wb.Worksheets(srtTableName).ListObjects.Add(SourceType:=xlSrcExternal, Source:=Array(Array( _
        "ODBC;" & connectionString), Array("E=db35211_CustomerMasterList;DefaultTable=Customers;")), _
        Destination:=wb.Sheets(srtTableName).Range("$A$1")).QueryTable
        .CommandText = Array("Select * FROM " & srtTableName)
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "テーブル_" & gDB & "_" & srtTableName
        .Refresh BackgroundQuery:=False
    End With
Case "SQL Server"
    With wb.Worksheets(srtTableName).ListObjects.Add(SourceType:=xlSrcExternal, Source:=Array( _
        "OLEDB;" & connectionString), Destination:=wb.Sheets(srtTableName).Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("""" & gDB & """.""dbo"".""" & srtTableName & """")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "テーブル_" & gDB & "_" & srtTableName
        .Refresh BackgroundQuery:=False
    End With
End Select
    Exit Sub
    
Err:
    Set con = Nothing
    MsgBox (Err.Description)

End Sub

大量データのCSVをソート方法

Excelのソート機能を使う方法

Dim wb As New Workbook
    Dim st As New Worksheet
    Dim sortField As Range
    Dim rg As Range

    'csvファイルを開く
    Set wb = Workbooks.Open("c:\abc.csv")

    'シートをセット（csvファイルはsheet1しかない）
    Set st = wb.Sheets(1)
    
    For Each rg In st.Range("1:1")
        If rg = "容器番号" Then 'ソートする列を探す
            Set sortField = rg
            Exit For
        End If
    Next
    'ソート(容器番号)
    st.UsedRange.Sort Key1:=sortField, Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin

大量のデータの時、65535行（excel2007以下）,100万？を超えた時

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source='c:\';" & _
                    "Extended Properties='Text;HDR=YES'"
    'c:\abc.csvというファイルをデータベーステーブルとして開く、「容器番号」という列を昇順でソート                
    Set rs = cn.Execute("SELECT * FROM abc.csv ORDER BY clng(容器番号) ASC")
    
    Do Until rs.EOF

       'データを書き出しなどの処理
       '...

       rs.MoveNext
    Loop

"HDR=YES"は最初の行はタイトルという意味。

ちなみに、下の順番にならないためには、

1
10
2
3
...

クエリーをこのようにclng関数を使う

SELECT * FROM abc.csv ORDER BY clng(容器番号) ASC

sqlではcastやconvertなど使いますが、Microsoft.Jet.OLEDB(Access)ではclngなどで文字列を数字に変換する

Excelのソートの話

Excel2007のソート

ActiveWorkbook.Worksheets("201210期").Sort.SortFields.Clear
    Worksheets("201210期").Sort.SortFields.Add Key:=Worksheets("201210期").Range("B4"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Worksheets("201210期").Sort
        .SetRange Worksheets("201210期").Range("A5:CO90")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Range("B4")→並び替え列
Order:=xlAscending→昇順、xlDescending降順
.SetRange Range("A5:CO90")→並び替え範囲
.Header = xlNo→ヘッダーありなし(xlYes,xlNo)、xlGuessの利用は避けたほうが無難。

Excel XP(2002)のソート

Worksheets("201210期").Range("A5:CO90").Sort Key1:=Worksheets("201210期").Range("B4"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin

Excelは下位互換ですので、XPも2007も2010も使えるためには、excel xpのコードで実装したほうが無難

COUNTIF,SUMIF,SUMPRODUCT

よく使うのはCOUNTIF,SUMIF
複数条件時は、SUMPRODUCTだと便利です。

商品名	クラス	販売数量	単価
リンゴ	A	3	200
リンゴ	S	2	600
バナナ	A	5	90
梨	B	7	100
リンゴ	B	12	50

求め	数式	結果
単価が100円以上の商品数	=COUNTIF(D2:D6,">=100")	3
リンゴの販売数は	=SUMIF(A2:A6,"=リンゴ",C2:C6)	17
リンゴの売上は	=SUMPRODUCT((A2:A6="リンゴ")*C2:C6*D2:D6)	2400
リンゴクラスAとAAの総売上は	=SUMPRODUCT((A2:A6="リンゴ")*((B2:B6="A")+(B2:B6="S"))*C2:C6*D2:D6)	1800

Excelの#DIV/0!エラー

Excel2007では通常はこれで隠すが

IFERROR(A1/A2,"")

Excel2000では(2003は確認していません)"IFERROR"がないので

IF(ISERROR(A1/A2),"",A1/A2)

で代替できる