スポンサーサイト

--–--–-- (--) --:--
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

全角ハイフン/マイナス(-)の数を統一するマクロ

2017–11–02 (Thu) 09:44
Sub ハイフン統一()
'ハイフンの数を一つに統一します

Dim MaxRow As Long
Dim MaxCol As Long
On Error Resume Next
Dim ws As Worksheet
Set ws = ActiveSheet
With ws.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With

Dim ken As Variant
ken = ws.Range(Cells(1, 1), Cells(MaxRow, MaxCol))
Dim x As Long, y As Long, j As Long, t As Long
For x = 1 To MaxRow
For y = 1 To MaxCol
If InStr(ken(x, y), "-") <> 0 Then
If ken(x, y) = "-" Then
Else
t = 0
For j = 1 To Len(ken(x, y))
If Mid(ken(x, y), j, 1) = "-" Then t = t + 1
Next
If t = Len(ken(x, y)) Then
ken(x, y) = "-"
End If
End If
End If
Next
Next
ws.Range(Cells(1, 1), Cells(MaxRow, MaxCol)) = ken
On Error GoTo 0
End Sub

ハイフン前・ハイフン後の文字列を抽出する

2017–10–16 (Mon) 00:06
Function hyphenmae(文字列 As Variant)
Dim mojiretsu As String
mojiretsu = 文字列
If InStr(mojiretsu, "-") <> 0 Then
hyphenmae = Left(mojiretsu, InStr(mojiretsu, "-") - 1)
End If
If InStr(mojiretsu, "-") <> 0 Then
hyphenmae = Left(mojiretsu, InStr(mojiretsu, "-") - 1)
End If
If mojiretsu = "" Thenaw
hyphenmae = ""
End If
End Function

Function hyphenato(文字列 As Variant)
Dim mojiretsu As String
mojiretsu = 文字列
If InStr(mojiretsu, "-") <> 0 Then
hyphenato = Mid(mojiretsu, InStr(mojiretsu, "-") + 1)
End If
If InStr(mojiretsu, "-") <> 0 Then
hyphenato = Mid(mojiretsu, InStr(mojiretsu, "-") + 1)
End If
If mojiretsu = "" Then
hyphenato = ""
End If
End Function

a_201710152340298af.png

ハイフン前・ハイフン後の文字列を抽出する

2017–10–15 (Sun) 19:18
Function hyphenmae(文字列 As Variant)
Dim mojiretsu As String
mojiretsu = 文字列
If InStr(mojiretsu, "-") <> 0 Then
hyphenmae = Left(mojiretsu, InStr(mojiretsu, "-") - 1)
End If
If InStr(mojiretsu, "-") <> 0 Then
hyphenmae = Left(mojiretsu, InStr(mojiretsu, "-") - 1)
End If
If mojiretsu = "" Thenaw
hyphenmae = ""
End If
End Function

Function hyphenato(文字列 As Variant)
Dim mojiretsu As String
mojiretsu = 文字列
If InStr(mojiretsu, "-") <> 0 Then
hyphenato = Mid(mojiretsu, InStr(mojiretsu, "-") + 1)
End If
If InStr(mojiretsu, "-") <> 0 Then
hyphenato = Mid(mojiretsu, InStr(mojiretsu, "-") + 1)
End If
If mojiretsu = "" Then
hyphenato = ""
End If
End Function
a_201710151918021c8.png

カタカナ⇔ひらがな相互変換

2017–10–15 (Sun) 12:56
Function hiragana(文字列 As Variant)
Dim mojiretsu As String
mojiretsu = 文字列
hiragana = StrConv(mojiretsu, vbHiragana)
End Function

Function katakana(文字列 As Variant)
Dim mojiretsu As String
mojiretsu = 文字列
katakana = StrConv(mojiretsu, vbKatakana)
End Function

a.png

VlookupN 解説付き

2017–10–05 (Thu) 01:29
VlookupN.pdf

Function VlookupN(検索する文字列 As Variant, 列番号 As Long, 範囲 As Variant, 前のセル As Range)
Dim hani As Variant
hani = 範囲
Dim MaxR As Long
Dim MaxH As Long
Dim RE, strPattern As String, msg As String, reMatch
Set RE = CreateObject("VBScript.RegExp")
MaxR = UBound(hani, 1)
MaxH = UBound(hani, 2)
Dim i As Long, j As Long, t As Long
For i = 1 To MaxR
For j = 1 To MaxH
If hani(i, j) = 検索する文字列 Then

With RE
.Pattern = strPattern
.IgnoreCase = True
.Global = True
strPattern = Replace(前のセル, "*", ".*")
For t = 1 To MaxH
On Error Resume Next
Set reMatch = .Execute(hani(i, t))
On Error GoTo 0
If IsEmpty(reMatch) = False Then
If reMatch.Count > 0 Then
VlookupN = reMatch(0).Value
If VlookupN <> "" Then
Dim IchiR As Long
Dim IchiC As Long
IchiR = i
IchiC = t
i = MaxR
j = MaxH
End If
End If
End If
Next
End With
End If
Next
Next
For IchiR = IchiR + 1 To MaxR
For IchiC = 1 To MaxH
If hani(IchiR, IchiC) = 検索する文字列 Then
VlookupN = hani(IchiR, 列番号)
End If
Next
Next
If VlookupN = 前のセル Then
VlookupN = ""
End If
End Function

« 前へ | HOME |  次へ »

プロフィール

はる

Author:はる
FC2ブログへようこそ!

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。