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

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

括弧内・括弧前・括弧後を取得

2017–10–09 (Mon) 14:23
()内・前外・後外の文字列を抽出します。

無題


Function kakkonai(文字列 As Variant)
Dim mojiretsu As String
If VarType(文字列) = vbString Then
mojiretsu = 文字列
Else
mojiretsu = 文字列.Value
End If
If InStr(mojiretsu, "(") <> 0 Then
mojiretsu = Mid(mojiretsu, InStr(mojiretsu, "(") + 1)
End If
If InStr(mojiretsu, ")") <> 0 Then
mojiretsu = Left(mojiretsu, InStr(mojiretsu, ")") - 1)
End If
If InStr(mojiretsu, "(") <> 0 Then
mojiretsu = Mid(mojiretsu, InStr(mojiretsu, "(") + 1)
End If
If InStr(mojiretsu, ")") <> 0 Then
mojiretsu = Left(mojiretsu, InStr(mojiretsu, ")") - 1)
End If
kakkonai = mojiretsu
End Function
Function kakkosoto(文字列 As Variant)
Dim mojiretsu As String
If VarType(文字列) = vbString Then
mojiretsu = 文字列
Else
mojiretsu = 文字列.Value
End If
If InStr(mojiretsu, "(") <> 0 Then
mojiretsu = Left(mojiretsu, InStr(mojiretsu, "(") - 1)
End If
If InStr(mojiretsu, "(") <> 0 Then
mojiretsu = Left(mojiretsu, InStr(mojiretsu, "(") - 1)
End If

kakkosoto = mojiretsu
End Function

Function kakkoato(文字列 As Variant)
Dim mojiretsu As String
If VarType(文字列) = vbString Then
mojiretsu = 文字列
Else
mojiretsu = 文字列.Value
End If
If InStr(mojiretsu, "(") <> 0 Then
mojiretsu = Mid(mojiretsu, InStr(mojiretsu, ")") + 1)
End If
If InStr(mojiretsu, "(") <> 0 Then
mojiretsu = Mid(mojiretsu, InStr(mojiretsu, ")") + 1)
End If

kakkoato = mojiretsu
End Function

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

シートを作成して貼り付ける

2017–10–01 (Sun) 22:07
シートを作成して貼り付ける

シートを作成して貼り付ける

Sub シートを作成して貼り付ける()
maisu = Application.InputBox(Prompt:="枚数を入力してください", Type:=1)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim sheet As Worksheet
Set sheet = ActiveSheet
sheet.Cells.Copy
If ActiveSheet.PageSetup.PrintArea = vbNullString Then
For i = 1 To maisu
Worksheets.Add after:=Worksheets(ActiveSheet.Name)
ActiveSheet.Name = sheet.Name & "(" & i & ")"
Worksheets(sheet.Name & "(" & i & ")").Paste
Next
Else
area = ActiveSheet.PageSetup.PrintArea
For i = 1 To maisu
Worksheets.Add after:=Worksheets(ActiveSheet.Name)
ActiveSheet.Name = sheet.Name & "(" & i & ")"
Worksheets(sheet.Name & "(" & i & ")").Paste
With ActiveSheet.PageSetup
.PrintArea = Range(area).Address
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Next
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

無題

 | HOME | 

プロフィール

あゆみ

Author:あゆみ
FC2ブログへようこそ!

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク