UVlookup 更新Ver

2017–09–21 (Thu) 12:35
UVlookup の更新Verを作成いたしました。この程度のマクロでも喜ばれるからありがたいです;;;
それだけ手抜きをしたい人が世の中にはあふれているという事ですね。このマクロ作るのにかかった時給を請求したいものです。あ、別にこのブログでも稼いでいるのでいらないですけどね←
でもこんなブログなんて時給計算すると10円ぐらい(笑)

下からVLOOKUPしてくれるマクロで、上に探してくれます。
Function UVlookupU(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = owari To 1 Step -1
For i = MaxCol To 1 Step -1
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To 1 Step -1
For i = MaxCol To 1 Step -1
If InStr(範囲(t, i), 前のセル.Text) <> 0 Then
t = t - ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count
Dim ken As Long
For ken = 1 To MaxCol
If InStr(hani(t, ken), 検索する文字列) <> 0 Then
UVlookupU = 範囲(t, 列番号)
End If
Next

If IsEmpty(UVlookupU) = True Then
UVlookupU = ""
End If
Exit Function
End If
Next
Next

If UVlookupU = "" Or UVlookupU = 0 Then
UVlookupU = ""
End If
End Function

下から検索してくれるVLOOKUPです。エラー処理追加。
Function Uvlookup(検索する文字列 As String, 範囲 As Range, 列番号 As Long)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = owari To 1 Step -1
If InStr(hani(i, 1), 検索する文字列) <> 0 Then
Uvlookup = hani(i, 列番号)
Exit For
End If
Next
End Function

憧れの曲。
スポンサーサイト

VlookupN 日付表示変更Ver 更新

2017–09–21 (Thu) 12:30
VLOOKUPNにに日付表示変更を付けました。凄く楽になります。そして楽しいです!!!

Function VlookupN(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = 1 To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 前のセル.Text) <> 0 Then
t = t + ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count

Dim sss As Long
For sss = 1 To MaxCol
If InStr(範囲(t, sss), 検索する文字列) <> 0 Then
VlookupN = 範囲(t, 列番号)
End If
Next
If IsEmpty(VlookupN) = True Then
VlookupN = ""
End If
Exit Function
End If


Next
Next

If VlookupN = "" Or VlookupN = 0 Then
VlookupN = ""
End If
End Function


Function VlookupNymd(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = 1 To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), CDate(前のセル.Text)) <> 0 Then
t = t + ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count

Dim sss As Long
For sss = 1 To MaxCol
If InStr(範囲(t, sss), 検索する文字列) <> 0 Then
VlookupN = 範囲(t, 列番号)
End If
Next
If IsEmpty(VlookupN) = True Then
VlookupN = ""
End If
Exit Function
End If


Next
Next

If VlookupNymd = "" Or VlookupNymd = 0 Then
VlookupNymd = ""
End If
End Function

無題


2017.9.20表示
Function VlookupNymdt(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = 1 To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), CDate(前のセル.Text)) <> 0 Then
t = t + ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count

Dim sss As Long
For sss = 1 To MaxCol
If InStr(範囲(t, sss), 検索する文字列) <> 0 Then
VlookupN = 範囲(t, 列番号)
End If
Next
If IsEmpty(VlookupN) = True Then
VlookupN = ""
End If
Exit Function
End If


Next
Next

If VlookupNymdt = "" Or VlookupNymdt = 0 Then
VlookupNymdt = ""
End If
End Function

2019/9/20表示
Function VlookupNymds(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = 1 To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), CDate(前のセル.Text)) <> 0 Then
t = t + ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count

Dim sss As Long
For sss = 1 To MaxCol
If InStr(範囲(t, sss), 検索する文字列) <> 0 Then
VlookupN = 範囲(t, 列番号)
End If
Next
If IsEmpty(VlookupN) = True Then
VlookupN = ""
End If
Exit Function
End If


Next
Next

If VlookupNymds = "" Or VlookupNymds = 0 Then
VlookupNymds = ""
End If
End Function

H29年9月20日表示
Function VlookupNgemd(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = 1 To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), CDate(前のセル.Text)) <> 0 Then
t = t + ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count

Dim sss As Long
For sss = 1 To MaxCol
If InStr(範囲(t, sss), 検索する文字列) <> 0 Then
VlookupN = 範囲(t, 列番号)
End If
Next
If IsEmpty(VlookupN) = True Then
VlookupN = ""
End If
Exit Function
End If


Next
Next

If VlookupNgmd = "" Or VlookupNgmd = 0 Then
VlookupNgmd = ""
End If
End Function

H29.9.20表示
Function VlookupNgemdt(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = 1 To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), CDate(前のセル.Text)) <> 0 Then
t = t + ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count

Dim sss As Long
For sss = 1 To MaxCol
If InStr(範囲(t, sss), 検索する文字列) <> 0 Then
VlookupN = 範囲(t, 列番号)
End If
Next
If IsEmpty(VlookupN) = True Then
VlookupN = ""
End If
Exit Function
End If


Next
Next

If VlookupNgemdt = "" Or VlookupNgemdt = 0 Then
VlookupNgemdt = ""
End If
End Function

H29/9/20です。
Function VlookupNgemds(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = 1 To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), CDate(前のセル.Text)) <> 0 Then
t = t + ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count

Dim z As Long
For z = 1 To MaxCol
If InStr(範囲(i, z), 検索する文字列) <> 0 Then
VlookupNgemds = 範囲(t, 列番号)
VlookupNgemds = Format(VlookupNgemds, "ge/m/d")
Exit Function
End If
Next
End If


Next
Next

If VlookupNgemds = "" Or VlookupNgemds = 0 Then
VlookupNgemds = ""
End If
End Function

平成29年9月20日表示。
Function VlookupNggemd(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = 1 To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), CDate(前のセル.Text)) <> 0 Then
t = t + ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count

Dim sss As Long
For sss = 1 To MaxCol
If InStr(範囲(t, sss), 検索する文字列) <> 0 Then
VlookupN = 範囲(t, 列番号)
End If
Next
If IsEmpty(VlookupN) = True Then
VlookupN = ""
End If
Exit Function
End If


Next
Next

If VlookupNggemd = "" Or VlookupNggemd = 0 Then
VlookupNggemd = ""
End If
End Function

平成29.9.20表示
Function VlookupNggemdt(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = 1 To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), CDate(前のセル.Text)) <> 0 Then
t = t + ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count

Dim sss As Long
For sss = 1 To MaxCol
If InStr(範囲(t, sss), 検索する文字列) <> 0 Then
VlookupN = 範囲(t, 列番号)
End If
Next
If IsEmpty(VlookupN) = True Then
VlookupN = ""
End If
Exit Function
End If


Next
Next

If VlookupNggemdt = "" Or VlookupNggemdt = 0 Then
VlookupNggemdt = ""
End If
End Function


平成29/9/20表示です。
Function VlookupNggemds(前のセル As Range, 範囲 As Range, 列番号 As Long, 検索する文字列 As Variant)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long, kaishi As Long, ichi As Long, ws As Worksheet

Set ws = 範囲.Worksheet
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
ichi = 0
If VarType(検索する文字列) <> vbString Then
検索する文字列 = 検索する文字列.Text
End If

For t = 1 To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), 検索する文字列) <> 0 Then
ichi = t
Exit For
End If
Next
If ichi <> 0 Then
Exit For
End If
Next


For t = ichi To owari
For i = 1 To MaxCol
If InStr(範囲(t, i), CDate(前のセル.Text)) <> 0 Then
t = t + ws.Cells(t + 範囲.Row, 範囲.Column + i).Rows.Count

Dim sss As Long
For sss = 1 To MaxCol
If InStr(範囲(t, sss), 検索する文字列) <> 0 Then
VlookupN = 範囲(t, 列番号)
End If
Next
If IsEmpty(VlookupN) = True Then
VlookupN = ""
End If
Exit Function
End If

Next
Next

If VlookupNggemds = "" Or VlookupNggemds = 0 Then
VlookupNggemds = ""
End If
End Function

VLOOKUPS 日付表示変更

2017–09–20 (Wed) 22:04
VLOOKUPSの日付表示変更を作りました。

2017年9月20日表示
Function Vlookups(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
For t = 1 To MaxCol
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then

Dim n As Long, s As Long, check As Long
check = 0
For s = 1 To MaxCol
For n = 0 To UBound(検索する文字列)
If InStr(hani(i, s), 検索する文字列(n)) <> 0 Then
検索する文字列(n) = 検索する文字列(n) & "qwert"
End If
Next
Next
For n = 0 To UBound(検索する文字列)
If Right(検索する文字列(n), 5) = "qwert" Then
check = check + 1
End If
Next
If check = UBound(検索する文字列) + 1 Then
Vlookups = hani(i, 列番号)
Exit Function
Else
For n = 0 To UBound(検索する文字列)
If InStr(検索する文字列(n), "qwert") <> 0 Then
検索する文字列(n) = Left(検索する文字列(n), Len(検索する文字列(n)) - 5)
End If
Next
End If
Exit For
End If
End If
Next
Next
Next
If IsEmpty(Vlookups) = True Then
Vlookups = ""
End If
End Function


Function VlookupSymd(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
For t = 1 To MaxCol
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then

Dim n As Long, s As Long, check As Long
check = 0
For s = 1 To MaxCol
For n = 0 To UBound(検索する文字列)
If InStr(hani(i, s), 検索する文字列(n)) <> 0 Then
検索する文字列(n) = 検索する文字列(n) & "qwert"
End If
Next
Next
For n = 0 To UBound(検索する文字列)
If Right(検索する文字列(n), 5) = "qwert" Then
check = check + 1
End If
Next
If check = UBound(検索する文字列) + 1 Then
VlookupSymd = Format(hani(i, 列番号), "yyyy年m月d日")
Exit Function
Else
For n = 0 To UBound(検索する文字列)
If InStr(検索する文字列(n), "qwert") <> 0 Then
検索する文字列(n) = Left(検索する文字列(n), Len(検索する文字列(n)) - 5)
End If
Next
End If
Exit For
End If
End If
Next
Next
Next
If IsEmpty(VlookupSymd) = True Then
VlookupSymd = ""
End If
End Function

2017.9.20表示
Function VlookupSymdt(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
For t = 1 To MaxCol
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then

Dim n As Long, s As Long, check As Long
check = 0
For s = 1 To MaxCol
For n = 0 To UBound(検索する文字列)
If InStr(hani(i, s), 検索する文字列(n)) <> 0 Then
検索する文字列(n) = 検索する文字列(n) & "qwert"
End If
Next
Next
For n = 0 To UBound(検索する文字列)
If Right(検索する文字列(n), 5) = "qwert" Then
check = check + 1
End If
Next
If check = UBound(検索する文字列) + 1 Then
VlookupSymdt = Format(hani(i, 列番号), "yyyy.m.d")
Exit Function
Else
For n = 0 To UBound(検索する文字列)
If InStr(検索する文字列(n), "qwert") <> 0 Then
検索する文字列(n) = Left(検索する文字列(n), Len(検索する文字列(n)) - 5)
End If
Next
End If
Exit For
End If
End If
Next
Next
Next
If IsEmpty(VlookupSymdt) = True Then
VlookupSymdt = ""
End If
End Function

2017/9/20表示
Function VlookupSymds(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
For t = 1 To MaxCol
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then

Dim n As Long, s As Long, check As Long
check = 0
For s = 1 To MaxCol
For n = 0 To UBound(検索する文字列)
If InStr(hani(i, s), 検索する文字列(n)) <> 0 Then
検索する文字列(n) = 検索する文字列(n) & "qwert"
End If
Next
Next
For n = 0 To UBound(検索する文字列)
If Right(検索する文字列(n), 5) = "qwert" Then
check = check + 1
End If
Next
If check = UBound(検索する文字列) + 1 Then
VlookupSymds = Format(hani(i, 列番号), "yyyy/m/d")
Exit Function
Else
For n = 0 To UBound(検索する文字列)
If InStr(検索する文字列(n), "qwert") <> 0 Then
検索する文字列(n) = Left(検索する文字列(n), Len(検索する文字列(n)) - 5)
End If
Next
End If
Exit For
End If
End If
Next
Next
Next
If IsEmpty(VlookupSymds) = True Then
VlookupSymds = ""
End If
End Function

H29年9月20日表示
Function VlookupSgemd(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
For t = 1 To MaxCol
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then

Dim n As Long, s As Long, check As Long
check = 0
For s = 1 To MaxCol
For n = 0 To UBound(検索する文字列)
If InStr(hani(i, s), 検索する文字列(n)) <> 0 Then
検索する文字列(n) = 検索する文字列(n) & "qwert"
End If
Next
Next
For n = 0 To UBound(検索する文字列)
If Right(検索する文字列(n), 5) = "qwert" Then
check = check + 1
End If
Next
If check = UBound(検索する文字列) + 1 Then
VlookupSgemd = Format(hani(i, 列番号), "ge年m月d日")
Exit Function
Else
For n = 0 To UBound(検索する文字列)
If InStr(検索する文字列(n), "qwert") <> 0 Then
検索する文字列(n) = Left(検索する文字列(n), Len(検索する文字列(n)) - 5)
End If
Next
End If
Exit For
End If
End If
Next
Next
Next
If IsEmpty(VlookupSgemd) = True Then
VlookupSgemd = ""
End If
End Function

H29.9.20表示
Function VlookupSgemdt(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
For t = 1 To MaxCol
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then

Dim n As Long, s As Long, check As Long
check = 0
For s = 1 To MaxCol
For n = 0 To UBound(検索する文字列)
If InStr(hani(i, s), 検索する文字列(n)) <> 0 Then
検索する文字列(n) = 検索する文字列(n) & "qwert"
End If
Next
Next
For n = 0 To UBound(検索する文字列)
If Right(検索する文字列(n), 5) = "qwert" Then
check = check + 1
End If
Next
If check = UBound(検索する文字列) + 1 Then
VlookupSgemdt = Format(hani(i, 列番号), "ge.m.d")
Exit Function
Else
For n = 0 To UBound(検索する文字列)
If InStr(検索する文字列(n), "qwert") <> 0 Then
検索する文字列(n) = Left(検索する文字列(n), Len(検索する文字列(n)) - 5)
End If
Next
End If
Exit For
End If
End If
Next
Next
Next
If IsEmpty(VlookupSgemdt) = True Then
VlookupSgemdt = ""
End If
End Function

H29/9/20表示
Function VlookupSgemds(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
For t = 1 To MaxCol
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then

Dim n As Long, s As Long, check As Long
check = 0
For s = 1 To MaxCol
For n = 0 To UBound(検索する文字列)
If InStr(hani(i, s), 検索する文字列(n)) <> 0 Then
検索する文字列(n) = 検索する文字列(n) & "qwert"
End If
Next
Next
For n = 0 To UBound(検索する文字列)
If Right(検索する文字列(n), 5) = "qwert" Then
check = check + 1
End If
Next
If check = UBound(検索する文字列) + 1 Then
VlookupSgemds = Format(hani(i, 列番号), "ge/m/d")
Exit Function
Else
For n = 0 To UBound(検索する文字列)
If InStr(検索する文字列(n), "qwert") <> 0 Then
検索する文字列(n) = Left(検索する文字列(n), Len(検索する文字列(n)) - 5)
End If
Next
End If
Exit For
End If
End If
Next
Next
Next
If IsEmpty(VlookupSgemds) = True Then
VlookupSgemds = ""
End If
End Function

平成29年9月20日表示
Function VlookupSggemd(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
For t = 1 To MaxCol
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then

Dim n As Long, s As Long, check As Long
check = 0
For s = 1 To MaxCol
For n = 0 To UBound(検索する文字列)
If InStr(hani(i, s), 検索する文字列(n)) <> 0 Then
検索する文字列(n) = 検索する文字列(n) & "qwert"
End If
Next
Next
For n = 0 To UBound(検索する文字列)
If Right(検索する文字列(n), 5) = "qwert" Then
check = check + 1
End If
Next
If check = UBound(検索する文字列) + 1 Then
VlookupSggemd = Format(hani(i, 列番号), "ggge年m月d日")
Exit Function
Else
For n = 0 To UBound(検索する文字列)
If InStr(検索する文字列(n), "qwert") <> 0 Then
検索する文字列(n) = Left(検索する文字列(n), Len(検索する文字列(n)) - 5)
End If
Next
End If
Exit For
End If
End If
Next
Next
Next
If IsEmpty(VlookupSggemd) = True Then
VlookupSggemd = ""
End If
End Function


平成29.9.20表示
Function VlookupSggemdt(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
For t = 1 To MaxCol
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then

Dim n As Long, s As Long, check As Long
check = 0
For s = 1 To MaxCol
For n = 0 To UBound(検索する文字列)
If InStr(hani(i, s), 検索する文字列(n)) <> 0 Then
検索する文字列(n) = 検索する文字列(n) & "qwert"
End If
Next
Next
For n = 0 To UBound(検索する文字列)
If Right(検索する文字列(n), 5) = "qwert" Then
check = check + 1
End If
Next
If check = UBound(検索する文字列) + 1 Then
VlookupSggemdt = Format(hani(i, 列番号), "ggge.m.d")
Exit Function
Else
For n = 0 To UBound(検索する文字列)
If InStr(検索する文字列(n), "qwert") <> 0 Then
検索する文字列(n) = Left(検索する文字列(n), Len(検索する文字列(n)) - 5)
End If
Next
End If
Exit For
End If
End If
Next
Next
Next
If IsEmpty(VlookupSggemdt) = True Then
VlookupSggemdt = ""
End If
End Function

平成29/9/20表示
Function VlookupSggemds(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
For t = 1 To MaxCol
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then

Dim n As Long, s As Long, check As Long
check = 0
For s = 1 To MaxCol
For n = 0 To UBound(検索する文字列)
If InStr(hani(i, s), 検索する文字列(n)) <> 0 Then
検索する文字列(n) = 検索する文字列(n) & "qwert"
End If
Next
Next
For n = 0 To UBound(検索する文字列)
If Right(検索する文字列(n), 5) = "qwert" Then
check = check + 1
End If
Next
If check = UBound(検索する文字列) + 1 Then
VlookupSggemds = Format(hani(i, 列番号), "ggge/m/d")
Exit Function
Else
For n = 0 To UBound(検索する文字列)
If InStr(検索する文字列(n), "qwert") <> 0 Then
検索する文字列(n) = Left(検索する文字列(n), Len(検索する文字列(n)) - 5)
End If
Next
End If
Exit For
End If
End If
Next
Next
Next
If IsEmpty(VlookupSggemds) = True Then
VlookupSggemds = ""
End If
End Function

VlookupN を作ってみました。

2017–09–19 (Tue) 22:11
VLookupNと言うマクロを作ってみました。

無題

こんな感じのものを作ります 凄く使いやすいですよ!!! ふふふ、ばんばん使って下さいね。
仕事が凄く楽になります。こんなに楽しても良いのでしょうか???

Function VlookupN(前のセル As String, 範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
For t = 1 To MaxCol
If InStr(hani(i, t), 前のセル) <> 0 Then
For j = 0 To UBound(検索する文字列)
t = 1
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
Else
t = t + 1
End If
If kazu = UBound(検索する文字列) Then
VlookupN = hani(i + 1, 列番号)
End If
Next
End If
Next
Next
End Function

UVlookup・Umatch を作りました。

2017–09–19 (Tue) 21:29
Uvlookup は、VLOOKUPを下からする物です(Under Vlookupです)

Function Uvlookup(検索する文字列 As String, 範囲 As Range, 列番号 As Long)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = owari To 1 Step -1
If InStr(hani(i, 1), 検索する文字列) <> 0 Then
Uvlookup = hani(i, 列番号)
Exit For
End If
Next
End Function

Umatch は、matchを下からする物です(Under Matchです)
Function Umatch(検索する文字列 As String, 範囲 As Range)
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long
hani = 範囲
owari = UBound(hani, 1)
For i = owari To 1 Step -1
If InStr(hani(i, 1), 検索する文字列) <> 0 Then
Umatch = i + 範囲.Row - 1
Exit For
End If
Next
End Function

UVLOOKUPは使いやすいかもしれませんね。Matchも使いやすいかも……。どうかなあ??? 皆様是非お使い下さい。
あともう一つ作りたいので、今からそれを作ってきます(*^_^*)(*^_^*)

VLOOKUPS を作ってみました

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


Function Vlookups(範囲 As Range, 列番号 As Long, ParamArray 検索する文字列())
Dim hani As Variant, owari As Long, MaxCol As Long, i As Long, j As Long, t As Long
hani = 範囲
owari = UBound(hani, 1)
MaxCol = UBound(hani, 2)
For i = 1 To owari
kazu = 0
t = 1
For j = 0 To UBound(検索する文字列)
If InStr(hani(i, t), 検索する文字列(j)) <> 0 Then
kazu = kazu + 1
If kazu - 1 = UBound(検索する文字列) Then
Vlookups = hani(i, 列番号)
Exit For
End If
End If
t = t + 1
Next
Next

End Function

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

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



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

アクティブシートをコピーして検索文字列の色を変更する

2017–09–19 (Tue) 07:37
おはようございます。
今日のマクロはアクティブシートをコピーし、検索文字列を指定。その後色を変更すると言うマクロです。私はたまに使うのですが、一般的にどのぐらい使うのかな……?と言う感じです;;;
Ctrl+Fは使い勝手の悪いときも有りますし、そう言うときはこっちの方が便利なのです……。

Sub アクティブシートをコピーして検索文字列の赤色にする()
Dim buf As String, MaxRow As Long, MaxCol As Long
buf = InputBox("名前を入力してください")
Application.ScreenUpdating = False
ActiveWorkbook.ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
With ActiveSheet.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With
Dim i As Long, j As Long
Dim ken As Variant
ken = Range(Cells(1, 1), Cells(MaxRow, MaxCol))
For i = 1 To MaxRow
For j = 1 To MaxCol
If InStr(ken(i, j), buf) <> 0 Then
Cells(i, j).Characters(Start:=InStr(ken(i, j), buf), Length:=Len(buf)).Font.ColorIndex = 3
End If
Next
Next
Application.ScreenUpdating = True
End Sub
Sub アクティブシートをコピーして検索文字列の青色にする()
Dim buf As String, MaxRow As Long, MaxCol As Long
buf = InputBox("名前を入力してください")
Application.ScreenUpdating = False
ActiveWorkbook.ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
With ActiveSheet.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With
Dim i As Long, j As Long
Dim ken As Variant
ken = Range(Cells(1, 1), Cells(MaxRow, MaxCol))
For i = 1 To MaxRow
For j = 1 To MaxCol
If InStr(ken(i, j), buf) <> 0 Then
Cells(i, j).Characters(Start:=InStr(ken(i, j), buf), Length:=Len(buf)).Font.ColorIndex = 5
End If
Next
Next
Application.ScreenUpdating = True
End Sub

Sub アクティブシートをコピーして検索文字列の緑色にする()
Dim buf As String, MaxRow As Long, MaxCol As Long
buf = InputBox("名前を入力してください")
Application.ScreenUpdating = False
ActiveWorkbook.ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
With ActiveSheet.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With
Dim i As Long, j As Long
Dim ken As Variant
ken = Range(Cells(1, 1), Cells(MaxRow, MaxCol))
For i = 1 To MaxRow
For j = 1 To MaxCol
If InStr(ken(i, j), buf) <> 0 Then
Cells(i, j).Characters(Start:=InStr(ken(i, j), buf), Length:=Len(buf)).Font.ColorIndex = 10
End If
Next
Next
Application.ScreenUpdating = True
End Sub

Sub アクティブシートをコピーして検索文字列の黄色にする()
Dim buf As String, MaxRow As Long, MaxCol As Long
buf = InputBox("名前を入力してください")
Application.ScreenUpdating = False
ActiveWorkbook.ActiveSheet.Copy after:=Worksheets(Worksheets.Count)
With ActiveSheet.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With
Dim i As Long, j As Long
Dim ken As Variant
ken = Range(Cells(1, 1), Cells(MaxRow, MaxCol))
For i = 1 To MaxRow
For j = 1 To MaxCol
If InStr(ken(i, j), buf) <> 0 Then
Cells(i, j).Characters(Start:=InStr(ken(i, j), buf), Length:=Len(buf)).Font.ColorIndex = 27
End If
Next
Next
Application.ScreenUpdating = True
End Sub

弾きたい~~~

マクロの使い方PDF

2017–09–18 (Mon) 21:43
マクロの使い方を書いたPDFを作りました。
マクロの使い方 送付用.pdf

無題

こう言うようなPDFです。EXCEL2007、EXCEL2010の物を作成しました。EXCEL2013・2016はもうしばらくお待ち下さい。これは、ご自由にお配り頂いて構いません!!!


貯蓄額管理リスト

2017–09–18 (Mon) 18:07
貯蓄額管理リストが欲しいと言うリクエストが有ったので作ってみました。
貯蓄率も出すことが出来ます。

無題

ボーナスがある場合は追加して下さい。

貯金額管理リスト.xlsx

日々の聖句読むマクロ

2017–09–17 (Sun) 20:07
無題

自分用の日々の聖句を読むマクロです
日付が変わって起動すると自動で日々の聖句も変わってくれます(^∇^)ノ
使いやすっ
この程度の単純なマクロでも作って頂くとお金が結構かかるのです。数万ぐらいは取られてしまうね。

日々の聖句読むマクロ

 | HOME |  次へ »

プロフィール

あゆみ

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

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク