- 追加された行はこの色です。
- 削除された行はこの色です。
- Excel へ行く。
#author("2023-06-30T08:36:24+09:00","","")
#author("2023-06-30T08:36:56+09:00","","")
[[ソフトウェア開発>SoftwareEngineering]] / [[Excel>./]]
* Excel [#s41eecb9]
** 整頓 [#h39312d9]
#highlightjs([vba])
Public Sub 整頓()
Dim TargetWorkbook As Workbook: Set TargetWorkbook = Application.ActiveWorkbook
Dim TargetWorksheet As Worksheet
For Each TargetWorksheet In TargetWorkbook.Worksheets
' ----------------------------------------------------------
' 水平スクロールバーの位置を左に移動する
' 垂直スクロールバーの位置を上に異動する
' ----------------------------------------------------------
Call TargetWorksheet.Activate
Dim TargetWindow As Window: Set TargetWindow = Application.ActiveWindow
TargetWindow.ScrollRow = 1
TargetWindow.ScrollColumn = 1
' ----------------------------------------------------------
' セル A1 を選択する
' ----------------------------------------------------------
Call TargetWorksheet.Range("A1").Select
' ----------------------------------------------------------
' 表示倍率を調整する
' ....表示倍率が 100% を超えている場合、表示倍率を 100 % に下げる
' ....表示倍率が 100% を超えていない場合、表示倍率は変更しない
' ----------------------------------------------------------
If (100 < TargetWindow.Zoom) Then
TargetWindow.Zoom = 100
End If
Next
' ----------------------------------------------------------
' 左端のワークシートを選択する
' ----------------------------------------------------------
Call TargetWorkbook.Worksheets.Item(1).Select
Call MsgBox("たいへんよくできました")
End Sub
** MStringUtils [#b1fc62e3]
#highlightjs([vba])
Option Explicit
Public Sub Test()
Call TestDupeString
Call TestIfThen
Call TestStartsWith
Call TestStartsWithAny
Call TestStartsWithIgnoreCase
Call TestEndsWith
Call TestEndsWithAny
Call TestEndsWithIgnoreCase
End Sub
''' <summary>AText で指定された文字列を ACount で指定された回数だけ繰り返した文字列を返します</summary>
Public Function DupeString(ByVal AText As String, ACount As Integer) As String
Dim Result As String
Dim Counter As Integer
For Counter = 1 To ACount
Result = Result & AText
Next Counter
DupeString = Result
End Function
Public Sub TestDupeString()
Debug.Assert ("000000" = DupeString("0", 6))
Debug.Assert ("ABABAB" = DupeString("AB", 3))
End Sub
''' <summary>AValue が True の場合は ATrue を返します、それ以外は AFalse を返します</summary>
Public Function IfThen(ByVal AValue As Boolean, ByVal ATrue As String, Optional AFalse As String = "") As String
IfThen = IIf(AValue, ATrue, AFalse)
End Function
Public Sub TestIfThen()
Debug.Assert ("真" = IfThen(True, "真", "偽"))
Debug.Assert ("偽" = IfThen(False, "真", "偽"))
Debug.Assert ("真" = IfThen(True, "真"))
Debug.Assert ("" = IfThen(False, "真"))
End Sub
''' <summary>AText が APrefix で始まる場合は True を返します、それ以外は False を返します</summary>
''' <remarks>大文字、小文字を区別します</remarks>
Public Function StartsWith(ByVal AText As String, ByVal APrefix As String) As Boolean
If (AText = APrefix) Then
StartsWith = True
Exit Function
End If
Dim PrefixLength As Integer: PrefixLength = Len(APrefix)
If (PrefixLength = 0) Then
StartsWith = False
Exit Function
End If
StartsWith = (APrefix = Left(AText, PrefixLength))
End Function
Public Sub TestStartsWith()
Debug.Assert (True = StartsWith("", ""))
Debug.Assert (False = StartsWith("", "abc"))
Debug.Assert (False = StartsWith("abcdef", ""))
Debug.Assert (True = StartsWith("abcdef", "abc"))
Debug.Assert (False = StartsWith("ABCDEF", "abc"))
End Sub
''' <summary>AText が APrefixArray のいずれかで始まる場合は True を返します、それ以外は False を返します</summary>
''' <remarks>大文字、小文字を区別します</remarks>
Public Function StartsWithAny(ByVal AText As String, ParamArray APrefixArray() As Variant)
Dim Prefix As Variant
For Each Prefix In APrefixArray
If (StartsWith(AText, Prefix)) Then
StartsWithAny = True
Exit Function
End If
Next
StartsWithAny = False
End Function
Public Sub TestStartsWithAny()
Debug.Assert (True = StartsWithAny("", ""))
Debug.Assert (False = StartsWithAny("", "abc"))
Debug.Assert (False = StartsWithAny("abcxyz", ""))
Debug.Assert (True = StartsWithAny("abcxyz", "abc"))
Debug.Assert (True = StartsWithAny("abcxyz", "xyz", "abc"))
Debug.Assert (False = StartsWithAny("abcxyz", "xyz", "ABC"))
End Sub
''' <summary>AText が APrefix で始まる場合は True を返します、それ以外は False を返します</summary>
''' <remarks>大文字、小文字を区別しません</remarks>
Public Function StartsWithIgnoreCase(ByVal AText As String, ByVal APrefix As String) As String
AText = LCase(AText)
APrefix = LCase(APrefix)
If (AText = APrefix) Then
StartsWithIgnoreCase = True
Exit Function
End If
Dim PrefixLength As Integer: PrefixLength = Len(APrefix)
If (PrefixLength = 0) Then
StartsWithIgnoreCase = False
Exit Function
End If
StartsWithIgnoreCase = (APrefix = Left(AText, PrefixLength))
End Function
Public Sub TestStartsWithIgnoreCase()
Debug.Assert (True = StartsWithIgnoreCase("", ""))
Debug.Assert (False = StartsWithIgnoreCase("", "abc"))
Debug.Assert (False = StartsWithIgnoreCase("abcdef", ""))
Debug.Assert (True = StartsWithIgnoreCase("abcdef", "abc"))
Debug.Assert (True = StartsWithIgnoreCase("ABCDEF", "abc"))
End Sub
''' <summary>AText が APrefix で終わる場合は True を返します、それ以外は False を返します</summary>
''' <remarks>大文字、小文字を区別します</remarks>
Public Function EndsWith(ByVal AText As String, ByVal ASuffix As String) As Boolean
If (AText = ASuffix) Then
EndsWith = True
Exit Function
End If
Dim SuffixLength As Integer: SuffixLength = Len(ASuffix)
If (SuffixLength = 0) Then
EndsWith = False
Exit Function
End If
EndsWith = (ASuffix = Right(AText, Len(ASuffix)))
End Function
Public Sub TestEndsWith()
Debug.Assert (True = EndsWith("", ""))
Debug.Assert (False = EndsWith("", "def"))
Debug.Assert (False = EndsWith("abcdef", ""))
Debug.Assert (True = EndsWith("abcdef", "def"))
Debug.Assert (False = EndsWith("ABCDEF", "def"))
Debug.Assert (False = EndsWith("ABCDEF", "cde"))
End Sub
''' <summary>AText が ASuffixArray のいずれかで終わる場合は True を返します、それ以外は False を返します</summary>
''' <remarks>大文字、小文字を区別します</remarks>
Public Function EndsWithAny(ByVal AText As String, ParamArray ASuffixArray() As Variant)
Dim Suffix As Variant
For Each Suffix In ASuffixArray
If (EndsWith(AText, Suffix)) Then
EndsWithAny = True
Exit Function
End If
Next
EndsWithAny = False
End Function
Public Sub TestEndsWithAny()
Debug.Assert (True = EndsWithAny("", ""))
Debug.Assert (False = EndsWithAny("", "abc"))
Debug.Assert (False = EndsWithAny("abcxyz", ""))
Debug.Assert (True = EndsWithAny("abcxyz", "xyz"))
Debug.Assert (False = EndsWithAny("abcxyz", "def", "XYZ"))
Debug.Assert (True = EndsWithAny("abcxyz", "def", "xyz"))
End Sub
''' <summary>AText が APrefix で終わる場合は True を返します、それ以外は False を返します</summary>
''' <remarks>大文字、小文字を区別しません</remarks>
Public Function EndsWithIgnoreCase(ByVal AText As String, ByVal ASuffix As String) As String
AText = LCase(AText)
ASuffix = LCase(ASuffix)
If (AText = ASuffix) Then
EndsWithIgnoreCase = True
Exit Function
End If
Dim SuffixLength As Integer: SuffixLength = Len(ASuffix)
If (SuffixLength = 0) Then
EndsWithIgnoreCase = False
Exit Function
End If
EndsWithIgnoreCase = (ASuffix = Right(AText, Len(ASuffix)))
End Function
Public Sub TestEndsWithIgnoreCase()
Debug.Assert (True = EndsWithIgnoreCase("", ""))
Debug.Assert (False = EndsWithIgnoreCase("", "def"))
Debug.Assert (False = EndsWithIgnoreCase("abcdef", ""))
Debug.Assert (True = EndsWithIgnoreCase("abcdef", "def"))
Debug.Assert (True = EndsWithIgnoreCase("ABCDEF", "def"))
Debug.Assert (False = EndsWithIgnoreCase("ABCDEF", "cde"))
End Sub
![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
