FC2ブログ

一括名前設定更新

2017–08–22 (Tue) 14:30
以前公開した「一括名前指定」の高速版を作りましたので公開致します。
2秒ぐらい早くなり、平均速度が0.1秒を切っています。

Sub 一括名前指定()
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
Dim awb As Workbook
Set awb = ActiveWorkbook
Dim Awbn As Names
Set Awbn = awb.Names
On Error Resume Next
Awbn.Names.Item("その他データ").Delete
Awbn.Add Name:="その他データ", RefersToR1C1:= _
"=OFFSET(INDIRECT(""その他データ""&""!$c$2""),,,COUNTA(INDIRECT(""その他データ""&""!$c:$c"")),12)"

Awbn.Item("一般健診").Delete
Awbn.Add Name:="一般健診", RefersToR1C1:= _
"=OFFSET(INDIRECT(""一般健康診断個人票""&""!$c$2""),,,COUNTA(INDIRECT(""一般健康診断個人票""&""!$c:$c"")),10)"

Awbn.Item("会社データ").Delete
Awbn.Add Name:="会社データ", RefersToR1C1:= _
"=OFFSET(INDIRECT(""会社データ""&""!$B$2""),,,COUNTA(INDIRECT(""会社データ""&""!$B:$B"")),19)"

Awbn.Item("再下請負").Delete
Awbn.Add Name:="再下請負", RefersToR1C1:= _
"=OFFSET(INDIRECT(""textデータ出力""&""!$A$2""),,,COUNTA(INDIRECT(""textデータ出力""&""!$B:$B"")),20)"

Awbn.Item("資格").Delete
Awbn.Add Name:="資格", RefersToR1C1:= _
"=OFFSET(INDIRECT(""資格証全て!""&""$B$2""),,,COUNTA(資格証全て!C1),6)"

Awbn.Item("住所データ").Delete
Awbn.Add Name:="住所データ", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$C$2:$AB$31"")"

Awbn.Item("フリガナ").Delete
Awbn.Add Name:="フリガナ", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$f$2:$f$31"")"

Awbn.Item("郵便番号").Delete
Awbn.Add Name:="郵便番号", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$g$2:$g$31"")"

Awbn.Add Name:="住所", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$h$2:$h$31"")"

Awbn.Add Name:="電話番号", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$i$2:$i$31"")"

Awbn.Add Name:="緊急連絡先住所", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$j$2:$j$31"")"

Awbn.Add Name:="緊急連絡先氏名", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$k$2:$k$31"")"

Awbn.Add Name:="緊急連絡先続柄", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$l$2:$l$31"")"

Awbn.Add Name:="緊急連絡先電話", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$m$2:$m$31"")"

Awbn.Add Name:="職種", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$n$2:$n$31"")"

Awbn.Add Name:="入社年月日", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$o$2:$o$31"")"

Awbn.Add Name:="経験年数", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$p$2:$p$31"")"

Awbn.Add Name:="生年月日", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$q$2:$q$31"")"

Awbn.Add Name:="年齢", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$r$2:$r$31"")"

Awbn.Add Name:="血液型", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$s$2:$s$31"")"

Awbn.Add Name:="雇入時教育", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$t$2:$t$31"")"

Awbn.Add Name:="職歴", RefersToR1C1:= _
"=OFFSET(INDIRECT(""職歴全て""&""!$B$2""),,,COUNTA(INDIRECT(""職歴全て""&""!$B:$B"")),5)"

Awbn.Add Name:="職歴氏名", RefersToR1C1:= _
"=OFFSET(INDIRECT(""職歴全て""&""!$B$2""),,,COUNTA(INDIRECT(""職歴全て""&""!$B:$B"")))"

Awbn.Add Name:="社会保険", RefersToR1C1:= _
"=OFFSET(INDIRECT(""社会保険データ""&""!$c$2""),,,COUNTA(INDIRECT(""社会保険データ""&""!$c:$c"")),20)"

Awbn.Add Name:="健康保険種類", RefersToR1C1:= _
"=OFFSET(INDIRECT(""社会保険データ""&""!$g$2""),,,COUNTA(INDIRECT(""社会保険データ""&""!$B:$B"")),)"

Awbn.Add Name:="健康保険番号", RefersToR1C1:= _
"=OFFSET(INDIRECT(""社会保険データ""&""!$h$2""),,,COUNTA(INDIRECT(""社会保険データ""&""!$c:$c"")),)"

Awbn.Add Name:="年金種類", RefersToR1C1:= _
"=OFFSET(INDIRECT(""社会保険データ""&""!$i$2""),,,COUNTA(INDIRECT(""社会保険データ""&""!$c:$c"")))"

Awbn.Add Name:="年金番号", RefersToR1C1:= _
"=OFFSET(INDIRECT(""社会保険データ""&""!$j$2""),,,COUNTA(INDIRECT(""社会保険データ""&""!$c:$c"")))"

Awbn.Add Name:="雇用保険番号", RefersToR1C1:= _
"=OFFSET(INDIRECT(""社会保険データ""&""!$k$2""),,,COUNTA(INDIRECT(""社会保険データ""&""!$c:$c"")))"

Awbn.Add Name:="労働契約書", RefersToR1C1:= _
"=OFFSET(INDIRECT(""社会保険データ""&""!$l$2""),,,COUNTA(INDIRECT(""社会保険データ""&""!$c:$c"")))"

Awbn.Add Name:="社保取得日", RefersToR1C1:= _
"=OFFSET(INDIRECT(""社会保険データ""&""!$m$2""),,,COUNTA(INDIRECT(""社会保険データ""&""!$c:$c"")))"

Awbn.Add Name:="所属会社", RefersToR1C1:= _
"=OFFSET(INDIRECT(""住所データ""&""!$B$2""),,,COUNTA(INDIRECT(""住所データ""&""!$B:$B"")))"

Awbn.Add Name:="氏名", RefersToR1C1:= _
"=OFFSET(INDIRECT(""住所データ""&""!$c$2""),,,COUNTA(INDIRECT(""住所データ""&""!$c:$c"")))"

Awbn.Add Name:="所属会社と氏名", RefersToR1C1:= _
"=OFFSET(INDIRECT(""住所データ""&""!$b$2""),,,COUNTA(INDIRECT(""住所データ""&""!$c:$c"")),2)"

Awbn.Add Name:="資格取得", RefersToR1C1:= _
"=INDIRECT(""住所データ""&""!$C$2:$AB$31"")"

Awbn.Add Name:="協力会社社員経験チェックシート", RefersToR1C1:= _
"=OFFSET(INDIRECT(""協力会社社員経験チェックシート""&""!$B$6""),,,COUNTA(INDIRECT(""協力会社社員経験チェ ックシート""&""!$B:$B""))+10,35)"

Awbn.Add Name:="運転免許証", RefersToR1C1:= _
"=OFFSET(INDIRECT(""運転免許証""&""!C2""),,,COUNTA(INDIRECT(""運転免許証""&""!$C:$C"")),7)"

Awbn.Add Name:="電離検診", RefersToR1C1:= _
"=OFFSET(INDIRECT(""電離検診""&""!$c$2""),,,COUNTA(INDIRECT(""電離検診""&""!$c:$c"")),4)"
On Error GoTo 0


For i = 1 To 30
On Error Resume Next
Awbn.Item("免許" & StrConv(i, vbWide)).Delete
Awbn.Item("免許名前" & StrConv(i, vbWide)).Delete
Awbn.Item("免許番号" & StrConv(i, vbWide)).Delete
Awbn.Item("免許取得日" & StrConv(i, vbWide)).Delete
Awbn.Item("免許取得先" & StrConv(i, vbWide)).Delete
Awbn.Item("資格" & StrConv(i, vbWide)).Delete
Awbn.Item("資格名前" & StrConv(i, vbWide)).Delete
Awbn.Item("資格番号" & StrConv(i, vbWide)).Delete
Awbn.Item("資格取得日" & StrConv(i, vbWide)).Delete
Awbn.Item("資格取得先" & StrConv(i, vbWide)).Delete
Awbn.Item("特別教育" & StrConv(i, vbWide)).Delete
Awbn.Item("特別教育名前" & StrConv(i, vbWide)).Delete
Awbn.Item("特別教育番号" & StrConv(i, vbWide)).Delete
Awbn.Item("特別教育取得日" & StrConv(i, vbWide)).Delete
Awbn.Item("特別教育取得先" & StrConv(i, vbWide)).Delete
Awbn.Item("職歴" & StrConv(i, vbWide)).Delete
Awbn.Item("職歴自" & StrConv(i, vbWide)).Delete
Awbn.Item("職歴至" & StrConv(i, vbWide)).Delete
Awbn.Item("職歴客先名" & StrConv(i, vbWide)).Delete
Awbn.Item("職歴件名" & StrConv(i, vbWide)).Delete
On Error GoTo 0
Next
Dim Wss As Worksheet
Set Wss = Worksheets("資格証全て")
Dim Wjs As Worksheet
Set Wjs = Worksheets("住所データ")

Dim Wjscell As Variant
ReDim Wjscell(29)
Dim hukazu As Variant
hukazu = Wjs.Range("c2:c31")
For i = 1 To 30
If hukazu(i, 1) <> "" Then
Wjscell(i - 1) = hukazu(i, 1)
Else
Exit For
End If
Next
With Wss.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With

Dim skn As Variant
skn = Range(Wss.Range("b1"), Wss.Cells(MaxRow, 2))
Dim sss As Variant
sss = Range(Wss.Range("c1"), Wss.Cells(MaxRow, 3))
Dim sk As String
sk = "資格証全て!"

For i = 2 To UBound(Wjscell) + 2
On Error Resume Next
If Wjscell(i - 2) <> "" Then
Dim t As Long
t = 2
Do Until skn(t, 1) = Wjscell(i - 2)
t = t + 1
Loop
Dim j As Long
j = t
Do While skn(j, 1) = Wjscell(i - 2)
If IsEmpty(skn(j, 1)) = True Then
Exit Do
End If
j = j + 1
Loop
Dim kazu As Long
kazu = 0
j = j - 1
For s = t To j
If sss(s, 1) = "免" Then
kazu = kazu + 1
End If
Next
If kazu <> 0 Then
Dim kosuu As Long
kosuu = kazu
kazu = t + kazu - 1
Awbn.Add Name:="免許" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("D" & kazu).Address & ":" & Range("G" & kazu).Address
Awbn.Add Name:="免許名前" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("D" & kazu).Address & ":" & Range("D" & kazu).Address
Awbn.Add Name:="免許番号" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("e" & kazu).Address & ":" & Range("e" & kazu).Address
Awbn.Add Name:="免許取得日" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("f" & kazu).Address & ":" & Range("f" & kazu).Address
Awbn.Add Name:="免許取得先" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("g" & kazu).Address & ":" & Range("g" & kazu).Address
t = t + kosuu
End If


ngAddress = ""
kazu = 0
kensaku = 0

On Error Resume Next
For s = t To j
If sss(s, 1) = "資" Then
kazu = kazu + 1
End If
Next
If kazu <> 0 Then
kosuu = kazu
kazu = t + kazu - 1
Awbn.Add Name:="資格" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("D" & t).Address & ":" & Range("G" & kazu).Address
Awbn.Add Name:="資格名前" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("D" & t).Address & ":" & Range("D" & kazu).Address
Awbn.Add Name:="資格番号" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("e" & t).Address & ":" & Range("e" & kazu).Address
Awbn.Add Name:="資格取得日" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("f" & t).Address & ":" & Range("f" & kazu).Address
Awbn.Add Name:="資格取得先" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("g" & t).Address & ":" & Range("g" & kazu).Address
t = t + kosuu
End If

kazu = 0
kaishi = 0
kensaku = 0


On Error Resume Next
For s = t To j
If sss(s, 1) = "特" Then
kazu = kazu + 1
End If
Next
If kazu <> 0 Then
kosuu = kazu
kazu = t + kazu - 1
Awbn.Add Name:="特別教育" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("D" & t).Address & ":" & Range("G" & kazu).Address
Awbn.Add Name:="特別教育名前" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("D" & t).Address & ":" & Range("D" & kazu).Address
Awbn.Add Name:="特別教育番号" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("e" & t).Address & ":" & Range("e" & kazu).Address
Awbn.Add Name:="特別教育取得日" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("f" & t).Address & ":" & Range("f" & kazu).Address
Awbn.Add Name:="特別教育取得先" & StrConv(i - 1, vbWide), RefersTo:="=" & sk & Range("g" & t).Address & ":" & Range("g" & kazu).Address
t = t + kosuu
End If
End If
rngAddress = ""
kazu = 0
kaishi = 0
kensaku = 0
tokukazu = 0
menkazu = 0
yousetsu = 0
shikazu = 0
Next
Dim Wsshoku As Worksheet
Set Wsshoku = Worksheets("職歴全て")
With Wsshoku.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With
Dim syokureki As Variant
syokureki = Range(Wsshoku.Range("b1"), Cells(MaxRow, 2))


For i = 2 To UBound(Wjscell) + 2
On Error Resume Next
If Wjscell(i - 2) <> "" Then

t = 2
Do Until syokureki(t, 1) = Wjscell(i - 2)
If IsEmpty(syokureki(t, 1)) = True Then
t = t - 1
Exit Do
End If
t = t + 1
Loop
j = t
Do While syokureki(j, 1) = Wjscell(i - 2)
If IsEmpty(syokureki(j, 1)) = True Then
Exit Do
End If

j = j + 1
kazu = kazu + 1
Loop
j = j - 1

If kazu <> 0 Then
kosuu = kazu
kazu = t + kazu - 1
Awbn.Add Name:="職歴" & StrConv(i - 1, vbWide), RefersTo:="=" & "職歴全て!" & Range("C" & t).Address & ":" & Range("F" & j).Address
Awbn.Add Name:="職歴自" & StrConv(i - 1, vbWide), RefersTo:="=" & "職歴全て!" & Range("C" & t).Address & ":" & Range("C" & j).Address
Awbn.Add Name:="職歴至" & StrConv(i - 1, vbWide), RefersTo:="=" & "職歴全て!" & Range("d" & t).Address & ":" & Range("d" & j).Address
Awbn.Add Name:="職歴客先名" & StrConv(i - 1, vbWide), RefersTo:="=" & "職歴全て!" & Range("e" & t).Address & ":" & Range("e" & j).Address
Awbn.Add Name:="職歴件名" & StrConv(i - 1, vbWide), RefersTo:="=" & "職歴全て!" & Range("F" & t).Address & ":" & Range("F" & j).Address
t = t + kosuu
End If
kazu = 0
End If
Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
End Sub
スポンサーサイト



« 付箋マクロ | HOME |  一括名前指定 修正版 »

コメント

コメントの投稿

 
管理者にだけ表示

 | HOME | 

プロフィール

はる

Author:はる
FC2ブログへようこそ!

最新記事

最新コメント

フリーエリア

月別アーカイブ

カテゴリ

ブロとも申請フォーム

検索フォーム

RSSリンクの表示

リンク