Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


198 / 73513 ←次へ | 前へ→

【78946】vlookup,index関数他について
質問  vba勉強中  - 17/3/14(火) 11:44 -

引用なし
パスワード
   いつもありがとうございます。簡単そうだと思って作っていたものが思いのほか複雑になってしまってわからなくなってしまいました。
タイトルはこれ使ったらいいのかな?というものを書いてみました。

やりたいことですが、シート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

60 hits

【78946】vlookup,index関数他について vba勉強中 17/3/14(火) 11:44 質問[未読]
【78949】Re:vlookup,index関数他について γ 17/3/14(火) 20:08 発言[未読]
【78954】Re:vlookup,index関数他について vba勉強中 17/3/15(水) 10:33 発言[未読]
【78955】Re:vlookup,index関数他について vba勉強中 17/3/15(水) 10:37 発言[未読]
【78957】仕様の追記について vba勉強中 17/3/15(水) 10:55 発言[未読]
【78959】得たい結果について vba勉強中 17/3/15(水) 11:41 発言[未読]
【78953】Re:vlookup,index関数他について γ 17/3/15(水) 7:21 発言[未読]
【78956】Re:vlookup,index関数他について vba勉強中 17/3/15(水) 10:48 発言[未読]
【78958】可能な限り正確な仕様を書きます vba勉強中 17/3/15(水) 11:15 発言[未読]
【78960】Re:vlookup,index関数他について vba勉強中 17/3/15(水) 15:17 お礼[未読]
【78962】Re:vlookup,index関数他について γ 17/3/15(水) 20:53 発言[未読]

198 / 73513 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free