| |
いつもありがとうございます。簡単そうだと思って作っていたものが思いのほか複雑になってしまってわからなくなってしまいました。
タイトルはこれ使ったらいいのかな？というものを書いてみました。
やりたいことですが、シートA,Bがあります。
シートAはデータベース、シートBは挿入先となっていてBは複数のページに渡ります。
シートAの3列目には1,2,3,1,2,1,1,1,2,3,4,5,1,2,3,....と不規則に連続した自然数が並んでいて、[1]が現れるごとにシートBは次のページに進みます。自然数の最大値は1~99になります。
1,2,3,1,2,1,1,1,2,3,4,5,1,2,3,....(数列n)
(｡)シートAの5列目には3パターンの文字列(K,L,M)があります。
(｢)シートAの14列目には特定の文字列とその後に数字が含まれることがあります。
(数字の位置は不定です)
(｣)シートAの15列目には5パターンの文字列があります。(a,b,c,d,e)(a<b<c<d<e)
(｡)のKに関してはほとんど不要であるので、L,Mとa,b,c,d,eの計10パターンの挿入先が数列nの各項に対して存在します。ただしKであった場合は数列nは次項に進みます。
挿入先は毎ページ12列x行となっています。(7<x<20)
1~6列はLに対する、7~12列はMに対応しています。
1,7列目は数列nの各項が入っていきます。2~5,8~12列目にはほとんどの場合1が入りますが、(｢)において数字が含まれる場合、その数字+1が入ります。
下に自分でできるだけやってみたものを示しますがもうぼろぼろです。この関数を使うと簡単等あれば教えていただければと思います。
相変わらずの説明下手、知識不足で申し訳ありませんがよろしくお願いします。
Sub maxtest()
Dim n As Long, nrow As Long, ncol As Long, i As Long
Dim target As Range, D3row As Long, D3col As Long
Dim sh1 As Worksheet, D3 As Range, nexttarget As Range
Dim cntA As Long, cntB As Long, cnt As Long
Dim span As Range, srow As Long, scol As Long, nexts As Range
Dim drrow As Long, drcol As Long
Dim dzrow As Long, dzcol As Long
Dim a As Long, b As Long
Set sh1 = Worksheets("データベース")
n = 1
cnt = 1
nrow = 5
ncol = 3
D3row = 8
D3col = 29
srow = 5
scol = 2
drrow = 10
drcol = 7
dzrow = 10
dzcol = 1
Set span = sh1.Cells(srow, scol)
Set nexts = span.Offset(1)
Set D3 = Cells(D3row, D3col)
Set target = sh1.Cells(nrow, ncol)
Set nexttarget = target.Offset(1)
Do While Not IsEmpty(target)
If target < nexttarget Then
n = n + 1
nrow = nrow + 1
Else
cntA = WorksheetFunction.CountIf(sh1.Range(sh1.Cells(nrow - n + 1, ncol), sh1.Cells _
(nrow, ncol + 3)), "L")
cntB = WorksheetFunction.CountIf(sh1.Range(sh1.Cells(nrow - n + 1, ncol), sh1.Cells _
(nrow, ncol + 3)), "M")
If cntA < 8 & cntB < 8 Then
For i = 1 To n
If target.Offset(cnt - n, 3) = "L" Then
D3.Offset(drrow, drcol) = target.Offset(cnt - n)
Select Case target.Offset(cnt - n, 12)
Case "I"
D3.Offset(drrow, drcol + 1) = "1"
Case "IIb"
If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
a = InStr(target.Offset(cnt - n, 11), "(他")
b = InStr(target.Offset(cnt - n, 11), "箇所)")
D3.Offset(drrow, drcol + 2) = Mid(target.Offset(cnt - n, 11), a, b - a)
Else
D3.Offset(drrow, drcol + 2) = "1"
End If
Case "IIa"
If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
a = InStr(target.Offset(cnt - n, 11), "(他")
b = InStr(target.Offset(cnt - n, 11), "箇所)")
D3.Offset(drrow, drcol + 3) = Mid(target.Offset(cnt - n, 11), a, b - a)
Else
D3.Offset(drrow, drcol + 3) = "1"
End If
Case "III"
If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
a = InStr(target.Offset(cnt - n, 11), "(他")
b = InStr(target.Offset(cnt - n, 11), "箇所)")
D3.Offset(drrow, drcol + 4) = Mid(target.Offset(cnt - n, 11), a, b - a)
Else
D3.Offset(drrow, drcol + 4) = "1"
End If
Case "IV"
If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
a = InStr(target.Offset(cnt - n, 11), "(他")
b = InStr(target.Offset(cnt - n, 11), "箇所)")
D3.Offset(drrow, drcol + 5) = Mid(target.Offset(cnt - n, 11), a, b - a)
Else
D3.Offset(drrow, drcol + 5) = "1"
End If
cnt = cnt + 1
drrow = drrow + 1
End Select
End If
If target.Offset(cnt - n, 3) = "M" Then
D3.Offset(dzrow, dzcol) = target.Offset(cnt - n)
Select Case target.Offset(cnt - n, 12)
Case "I"
D3.Offset(dzrow, dzcol + 1) = "1"
Case "IIb"
If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
a = InStr(target.Offset(cnt - n, 11), "(他")
b = InStr(target.Offset(cnt - n, 11), "箇所)")
D3.Offset(dzrow, dzcol + 2) = Mid(target.Offset(cnt - n, 11), a, b - a)
Else
D3.Offset(dzrow, dzcol + 2) = "1"
End If
Case "IIa"
If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
a = InStr(target.Offset(cnt - n, 11), "(他")
b = InStr(target.Offset(cnt - n, 11), "箇所)")
D3.Offset(dzrow, dzcol + 3) = Mid(target.Offset(cnt - n, 11), a, b - a)
Else
D3.Offset(drrow, dzcol + 3) = "1"
End If
Case "III"
If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
a = InStr(target.Offset(cnt - n, 11), "(他")
b = InStr(target.Offset(cnt - n, 11), "箇所)")
D3.Offset(dzrow, dzcol + 4) = Mid(target.Offset(cnt - n, 11), a, b - a)
Else
D3.Offset(dzrow, dzcol + 4) = "1"
End If
Case "IV"
If target.Offset(cnt - n, 11) Like "*" & "(他" & "*" & "箇所)" Then
a = InStr(target.Offset(cnt - n, 11), "(他")
b = InStr(target.Offset(cnt - n, 11), "箇所)")
D3.Offset(dzrow, dzcol + 5) = Mid(target.Offset(cnt - n, 11), a, b - a)
Else
D3.Offset(dzrow, dzcol + 5) = "1"
End If
cnt = cnt + 1
dzrow = dzrow + 1
End Select
End If
srow = srow + 1
Set span = sh1.Cells(srow, scol)
Set nexts = span.Offset(1)
Next
End If
D3row = D3row + 37
cnt = 1
n = 1
End If
nrow = nrow + 1
Set target = sh1.Cells(nrow, ncol)
Set nexttarget = target.Offset(1)
Set span = sh1.Cells(srow, scol)
Set nexts = span.Offset(1)
Set D3 = Cells(D3row, D3col)
Loop
End Sub
|
|
vba勉強中
- 17/3/14(火) 11:44 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
≪
