ブックを開いたときに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

表示マクロ マニュアル

2017–09–27 (Wed) 22:00
表示マクロ マニュアル.pdf

これから、マニュアルを色々と作成しなければならなくなりました。アドインの共有とかが出てくるので本当に大変です;;;

無題

結局メンテナンスをするのも私だし、メンテナンス出来る人がいなくなったらどうするんだろう……。私、移動の話でてるんだけどなあ← 代表から次の場所へって言われてるのよ!!!

表示マクロ

2017–09–25 (Mon) 22:26
Function HyouG(表示 As Variant)
HyouG = Format(表示, "g")
End Function
Function HyouGGG(表示 As Variant)
HyouGGG = Format(表示, "ggg")
End Function
Function HyouYYYY(表示 As Variant)
HyouYYYY = Format(表示, "yyyy")
End Function
Function HyouE(表示 As Variant)
HyouE = Format(表示, "e")
End Function
Function HyouM(表示 As Variant)
HyouM = Format(表示, "m")
End Function
Function HyouD(表示 As Variant)
HyouD = Format(表示, "d")
End Function

Function HyouGEN(表示 As Variant)
HyouGEN = Format(表示, "ge年")
End Function
Function HyouMG(表示 As Variant)
HyouMG = Format(表示, "m月")
End Function
Function HyouDN(表示 As Variant)
HyouDN = Format(表示, "d日")
End Function
Function HyouGGGEN(表示 As Variant)
HyouGGGEN = Format(表示, "ggge年")
End Function

無題

VLOOKUPS 関数。

2017–09–22 (Fri) 18:26
VLOOKUPS 関数。
Vlookups + 細かく指定 が出来る関数を作成いたしました。検索する文字列と列番号は、文字列、列番号、文字列、列番号の順番で入力してください。

通常のVlookupで複数条件検索の出来る関数です。今まではワイルドカードが使えなかったのですが、今回からワイルドカードが使える様になりました。*(アスタリスク)指定が出来ます。

Function VlookupShitei(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列と列番号())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, check As Long, ken As Variant
Dim RE, strPattern As String, msg As String, reMatch
Set RE = CreateObject("VBScript.RegExp")
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ReDim ken(owari, UBound(検索する文字列と列番号) + 1)
If (UBound(検索する文字列と列番号) + 1) Mod 2 = 0 Then
Dim k As Integer
For i = 0 To UBound(検索する文字列と列番号) Step 2
strPattern = Replace(検索する文字列と列番号(i), "*", ".*")
With RE
.Pattern = strPattern
.IgnoreCase = True
.Global = True
For j = 1 To owari
On Error Resume Next
Set reMatch = .Execute(範囲(j, 検索する文字列と列番号(i + 1)))
On Error GoTo 0
If IsEmpty(reMatch) = False Then
If reMatch.Count > 0 Then
ken(j, i) = j
End If
End If

Next
End With

Next
For i = 0 To UBound(ken)
check = 0
For j = 0 To UBound(検索する文字列と列番号) + 1
If ken(i, j) <> "" Then
check = check + 1
End If
If check = (UBound(検索する文字列と列番号) + 1) / 2 Then
VlookupShitei = 範囲(i, 列番号)
Exit Function
End If
Next
Next
If IsEmpty(VlookupShitei) = True Then
VlookupShitei = ""
End If
Else
VlookupShitei = ""
End If


Set reMatch = Nothing
Set RE = Nothing
End Function


次は下から検索するUVlookupの指定バージョンです。

Function UVlookupShitei(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列と列番号())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, check As Long, ken As Variant
Dim RE, strPattern As String, msg As String, reMatch
Set RE = CreateObject("VBScript.RegExp")
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ReDim ken(owari, UBound(検索する文字列と列番号) + 1)
If (UBound(検索する文字列と列番号) + 1) Mod 2 = 0 Then
Dim k As Integer
For i = 0 To UBound(検索する文字列と列番号) Step 2
strPattern = Replace(検索する文字列と列番号(i), "*", ".*")
With RE
.Pattern = strPattern
.IgnoreCase = True
.Global = True
For j = owari To 1 Step -1
On Error Resume Next
Set reMatch = .Execute(範囲(j, 検索する文字列と列番号(i + 1)))
On Error GoTo 0
If IsEmpty(reMatch) = False Then
If reMatch.Count > 0 Then
ken(j, i) = j
End If
End If

Next
End With

Next
For i = UBound(ken) To 0 Step -1
check = 0
For j = 0 To UBound(検索する文字列と列番号) + 1
If ken(i, j) <> "" Then
check = check + 1
End If
If check = (UBound(検索する文字列と列番号) + 1) / 2 Then
UVlookupShitei = 範囲(i, 列番号)
Exit Function
End If
Next
Next
If IsEmpty(UVlookupShitei) = True Then
UVlookupShitei = ""
End If
Else
UVlookupShitei = ""
End If
Set reMatch = Nothing
Set RE = Nothing
End Function

なかなか綺麗なマクロを作ることが出来ないのが悔しくて悲しいです。
エラー処理無し 条件が満たない場合は自動で空白になります。

VLOOKUPS 関数.docx

VLOOKUPS 関数.pdf

VlookupShitei を作ってみました

2017–09–22 (Fri) 14:38
VlookupShitei を作ってみました。
これ、どうなのかなあ;;;
Microsoftさん作らないかなあ←(笑) 最強の「IFS」関数もでたんだからさあ~~~。出してくれてもいいじゃない!!!



Function VlookupShitei(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列と列番号())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, check As Long, ken As Variant
Dim RE, strPattern As String, msg As String, reMatch
Set RE = CreateObject("VBScript.RegExp")
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ReDim ken(owari, UBound(検索する文字列と列番号) + 1)
If (UBound(検索する文字列と列番号) + 1) Mod 2 = 0 Then
Dim k As Integer
For i = 0 To UBound(検索する文字列と列番号) Step 2
strPattern = Replace(検索する文字列と列番号(i), "*", ".*")
With RE
.Pattern = strPattern
.IgnoreCase = True
.Global = True
For j = 1 To owari
On Error Resume Next
Set reMatch = .Execute(範囲(j, 検索する文字列と列番号(i + 1)))
On Error GoTo 0
If IsEmpty(reMatch) = False Then
If reMatch.Count > 0 Then
ken(j, i) = j
End If
End If

Next
End With

Next
For i = 0 To UBound(ken)
check = 0
For j = 0 To UBound(検索する文字列と列番号) + 1
If ken(i, j) <> "" Then
check = check + 1
End If
If check = (UBound(検索する文字列と列番号) + 1) / 2 Then
VlookupShitei = 範囲(i, 列番号)
Exit Function
End If
Next
Next
If IsEmpty(VlookupShitei) = True Then
VlookupShitei = ""
End If
Else
VlookupShitei = ""
End If


Set reMatch = Nothing
Set RE = Nothing
End Function


n番煎じだとは思いますけどね……。こう言うのを作っているときが一番好きです。

クライスラーの「愛の悲しみ」って良い曲だね。美しい;;;



ピアノ版はあんまり好きでは無いですが、ピアノの独奏も有るのですよ。有名な曲だから間違えたらばれそう(特に最初)

« 前へ | HOME |  次へ »

プロフィール

あゆみ

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

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク