

excelで空文字を埋めたい  
行の増える方向に、  
罫線から値まで 埋めたい:その値  
値から値まで 埋めたい:着色  
値から罫線まで 埋めたい:その値

探しています。よろしくお願いします。

20200319---------------------------  
チャレンジしてみました。  
汎用性をもたせる方法を教えて下さい。  
①maxr=50固定をはずしたい。  
②1列しか出来ない。全部の列で実行したい。

[code]

    Sub 罫線から罫線まで文字埋め()
        ic = 1
        maxr = 50
        moji = ""
        For i = 1 To maxr
            If Cells(i, ic) <> "" Then
                 moji = Cells(i, ic)
             Else
                 Cells(i, ic) = moji
             End If
             If Cells(i,ic).Borders(xlEdgeBottom).LineStyle = -4142 Then
             Else
               moji = ""
             End If
        Next
        For i = maxr To 2 Step -1                    
            If Cells(i, ic) <> "" Then
                moji = Cells(i, ic)
             Else
                Cells(i, ic) = moji
              End If
              If Cells(i - 1,ic).Borders(xlEdgeBottom).LineStyle = -4142 Then
              Else
                 moji = ""
              End If
          Next
    end sub
    
[/code]


CC BY-SA 4.0
2020-03-17T23:11:36.773
63946
2020-04-02T17:19:01.217
2020-03-19T13:54:47.800
17199
17199
question
vba
excelで行の増える方向に、罫線から値まで 値から値まで 値から罫線まで 埋めたい


取り急ぎ、`maxr=50固定をはずしたい` について考えてみました。

罫線の最下行番号を取得できないため、`maxr`を50に固定しているという理解で  
あっておりますでしょうか？

少し時間かかってしまいますが、  
`getmaxrowkeisen`という関数にて罫線のある最下行を取得し、そちらを`maxr`とするという  
方法ではご要望とは異なりますでしょうか。

[code]

    Sub 罫線から罫線まで文字埋め()
    
        Dim maxRowKeisen As Double
        Dim chkFlg As Boolean
    
        ic = 1
        maxr = getmaxrowkeisen(Rows.Count)
        moji = ""
        For i = 1 To maxr
            If Cells(i, ic) <> "" Then
                 moji = Cells(i, ic)
             Else
                 Cells(i, ic) = moji
             End If
             If Cells(i, ic).Borders(xlEdgeBottom).LineStyle = -4142 Then
             Else
               moji = ""
             End If
        Next
        For i = maxr To 2 Step -1
            If Cells(i, ic) <> "" Then
                moji = Cells(i, ic)
             Else
                Cells(i, ic) = moji
              End If
              If Cells(i - 1, ic).Borders(xlEdgeBottom).LineStyle = -4142 Then
              Else
                 moji = ""
              End If
          Next
    End Sub
    
    Function getmaxrowkeisen(maxRow As Double) As Double
    
      Do While chkFlg = False
        If Cells(maxRow, 1).Borders(xlEdgeBottom).LineStyle = -4142 Then
          maxRow = maxRow - 1
        Else
          chkFlg = True
          getmaxrowkeisen = maxRow
        End If
      Loop
    
    End Function
    
[/code]


CC BY-SA 4.0
2020-04-02T17:19:01.217
65313
2020-04-02T17:19:01.217
32032
63946
answer