0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

[ハヤカワ書房専用]EXCELで必ず使うVBA 数式リストのエクスポート Excel VBA Export Formula List

Last updated at Posted at 2017-10-10

Excel 2013 Later用ではなくてノーベル賞にあやかるハヤカワ書房でも使えるようにしました

Exportformula4Hayakawa
Sub Exportformula4Hayakawa()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet:
Dim Urng As Range
Dim r As Range
Dim strProjectName As String: strProjectName = wb.FullName
Dim strFilePath As String: strFilePath = wb.Path
Dim fileNo As Integer
Dim buf As String
Dim i As Long
Dim sr As ADODB.Stream: Set sr = New ADODB.Stream
Dim CNT
If Dir(strFilePath & "\" & "a_FormulaSjis.txt") <> "" Then Kill strFilePath & "\" & "a_FormulaSjis.txt"
If Dir(strFilePath & "\" & "a_FormulaUTF8.csv") <> "" Then Kill strFilePath & "\" & "a_FormulaUTF8.csv"
fileNo = FreeFile
Open strFilePath & "\" & "a_FormulaSjis.txt" For Append As #fileNo
sr.LineSeparator = adCRLF
sr.Mode = adModeReadWrite
sr.Type = adTypeText
sr.Charset = "UTF-8"
sr.Open
buf = ""
buf = "SheetName" & "," & "address" & "," & "formula,formulaR1C1,format" & "," & "formatLocal,HasArray" & "," & "Count" & "," & "mergecells,FontName,FontSize,Width,Height" & vbCrLf
For Each ws In wb.Worksheets
Set Urng = ws.UsedRange
For Each r In Urng
If Isformula2010(r) = True Then
buf = buf & ws.Name & "," & r.Address & ","
buf = buf & """" & "`" & r.FormulaR1C1 & "`" & """"
buf = buf & "," & """" & "`" & r.Formula & "`" & """" & "," & """" & r.NumberFormat & """" & "," & """" & r.NumberFormatLocal & """" & ", " & r.HasArray & ","  & r.Count & "," & r.MergeCells & "," & r.Font.Name & "," & r.Font.Size & "," & r.Width & "," & r.Height & "," & vbCrLf
If CNT >= 10000 Then GoTo Terminate Else CNT = CNT + 1
End If
Next
Next
GoTo Terminate
Exit Sub
Terminate:
sr.WriteText buf, adWriteChar
sr.SaveToFile strFilePath & "\" & "a_FormulaUTF8.csv"
sr.Close
Print #fileNo, buf
Close #fileNo
End Sub
Function isFormula2010(Rng As Range) As Boolean
If Rng.Value = CStr(Rng.Cells.Formula) Then isFormula2010 = False Else isFormula2010 = True
End Function

機能

古いバージョンへ対応

これはIsFormulaを使いたいところですがこの記事を書いている時点でExcel2007を使っている株式会社 ハヤカワ書房さんのためにIsformula2010にしました。
と同時にUTF8形式のCSV shif-Jis 形式のテキストと2種類だしています。

数式以外の必要事項

シート名 アドレス `数式` `R1C1形式` 表示形式 表示形式ローカル 配列数式か カウント 結合か フォント名 フォントサイズ 幅 高さ
数式はShift+@で出る「`」を使用しています。

サーキットブレーカー

1万を超えた場合は強制終了します。

0
1
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
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?