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

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

ブックを開いたときにCSVのデータベースをコピーする

2017–09–29 (Fri) 22:21
「ブックを開いたときにCSVのデータベースをコピーする」マクロを作成しました。

VBAのエディタを開きMicrosoft Excel Objects の「Thisworkbook」に記入する。
・コピーしたいシート名 に シート名
・読み込むCSVをtxtファイルにする にアドレスを入れる
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim ws As Worksheet, flg As Integer
flg = 0
For Each ws In ThisWorkbook
If ws.Name = "コピーしたいシート名" Then
flg = 1
Exit For
End If
Next
If flg = 0 Then
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = "コピーしたいシート名"
Dim aWb As Workbook
Set aWb = ActiveWorkbook
Dim aWs As ActiveWorkbook
Set aWs = Worksheets("コピーしたいシート名")
Dim TextPath As String

TextPath = "読み込むCSVをtxtファイルにする"
Workbooks.Opentext Filename:=TextPath, _
DataType:=xlDelimited, _
Tab:=True, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=True, _
Otherchar:="/"

ActiveWorkbook.Sheets(1).Cells.Copy aWs.Range("A1")
ActiveWorkbook.Close False

Application.ScreenUpdating = True
End Sub

無題

ブックを開いたときにCSVのデータベースをコピーする.pdf

 | HOME |  次へ »

プロフィール

あゆみ

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

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク