管理者とリクエストについて

2037–04–30 (Thu) 09:58
管理者は中小企業事務員です。
入社時より、主に入構書類を担当し、苦労が多かったためこのサイトを立ち上げました。
どなたでも無料で安全に使用することが出来ます。

システム作成リクエストも承っております。
(本業の仕事量により、断る場合もございます)

導入頂いた企業様、有りましたらご一報くださると幸いです。

000335544.jpg

yoru_1.jpg

なにとぞよろしくお願い致します。



最新版ソフトのダウンロードはこちら。
読書感想.zip
はな時計.zip
はなお手紙聖書.zip

趣味全開ブログはこちら
スポンサーサイト

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

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

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

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

無題

setH(表示指定)関数を作成しました。

2017–09–23 (Sat) 18:21
ユーザ定義(表示)を入れたセルにこの関数を入れると、関数が固定させます。
マクロはこういう痒いところに手が届くのがいいですね。
「固定してたのに変わりやがった。エクセルの馬鹿」と言うのが嫌なのでb

Function setH(nm As Variant)
Dim hk As Variant
hk = Range(Application.ThisCell.Address).NumberFormatLocal
setH = WorksheetFunction.Text(nm, hk)
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も使いやすいかも……。どうかなあ??? 皆様是非お使い下さい。
あともう一つ作りたいので、今からそれを作ってきます(*^_^*)(*^_^*)

 | HOME |  次へ »

プロフィール

あゆみ

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

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク