Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
値の代入 空白をスキップしたい
投稿日時: 21/06/16 16:03:21
投稿者: みみ1212

よろしくお願いします。
 
列にある文字列を行に転記したいと思っています。
その際、空白は無視し、行に転記する際には詰めて代入したいのです。
VBA初心者で色々調べてはいるのですが、スキップする方法がわかりません。
どなたか教えていただけないでしょうか。
よろしくお願いいたします。
 
Sub test()
 
Dim g As Integer 'コピー先 行
Dim r As Integer 'コピー元 列
 
g = 90
r = 9
 
Do Until Cells(27, r).Value = Cells(27, r).End(xlToRight).Column
      Cells(g, 9).Value = Cells(27, r).Value
 
 If Cells(27, r).Value = "" Then
  
 
 End If
 
      r = r + 1
      g = g + 1
    
  Loop
 
End Sub

回答
投稿日時: 21/06/16 16:58:38
投稿者: sk

引用:
列にある文字列を行に転記したいと思っています。

引用:
g = 90
r = 9
  
Do Until Cells(27, r).Value = Cells(27, r).End(xlToRight).Column
      Cells(g, 9).Value = Cells(27, r).Value

記述されているコードを拝見した限りでは、27 行目の 9 列目のセル
( I27 セル)から同じ行の最後のデータセルまでの行範囲を
90 行目の 9 列目のセル( I90 セル)から始まる 1 つの列範囲に
変換しようとされているように読めるのですが。
(列 -> 行 ではなく、行 -> 列)
 
引用:
その際、空白は無視し、行に転記する際には詰めて代入したいのです。

(標準モジュール)
------------------------------------------------------------------------
Sub TransformRowToColumn()
 
    Const SourceFirstCellAddress As String = "I27"
    Const DestinationFirstCellAddress As String = "I90"
     
    Dim rngSourceFirstCell As Range
     
    Set rngSourceFirstCell = Range(SourceFirstCellAddress)
     
    Dim lngTargetRow As Long
    Dim lngFirstColumn As Long
    Dim lngLastColumn As Long
     
    lngTargetRow = rngSourceFirstCell.Row
    lngFirstColumn = rngSourceFirstCell.Column
    lngLastColumn = Cells(lngTargetRow, Columns.Count).End(xlToLeft).Column
     
    Dim rngDestinationCell As Range
    Dim rngTargetCell As Range
    Dim lngColumn As Long
     
    Set rngDestinationCell = Range(DestinationFirstCellAddress)
     
    Application.ScreenUpdating = False
     
    For lngColumn = lngFirstColumn To lngLastColumn
        Set rngTargetCell = Cells(lngTargetRow, lngColumn)
        If rngTargetCell.Value <> "" Then
            rngDestinationCell.Value = rngTargetCell.Value
            Set rngDestinationCell = rngDestinationCell.Offset(1, 0)
        End If
        Set rngTargetCell = Nothing
    Next
     
    Application.ScreenUpdating = True
     
    rngDestinationCell.Select
     
    Set rngDestinationCell = Nothing
    Set rngSourceFirstCell = Nothing
     
End Sub
------------------------------------------------------------------------

回答
投稿日時: 21/06/16 20:29:00
投稿者: WinArrow
投稿者のウェブサイトに移動

掲示のコードには、大きな問題点があります。
   
(1)終了判定
>Do Until Cells(27, r).Value = Cells(27, r).End(xlToRight).Column
左辺は、セルの値
右辺は列番号
おかしいですよね?
   
(2)空白を除いて
意図とコードがちがう・・・・転送する前に空白判定しないといけないよね?
   
(3)列番号と行番号を一緒にカウントアップしている
 空白の場合は、転送元だけカウントアップします。
   
多分、こんなことがお望みなんではないでしょうか?

Sub 列行変換複写()
Dim r As Long, r_max As Long
Dim g As Long

    r_max = Cells(27, Columns.Count).End(xlToLeft).Column
    g = 90
    For r = 9 To r_max
        If Cells(27, r).Value <> "" Then
            Cells(g, 9).Value = Cells(27, r).Value
            g = g + 1
        End If
    Next
End Sub

投稿日時: 21/06/16 21:04:04
投稿者: みみ1212

お二方ありがとうございました。
勉強しなおします。
今後ともよろしくお願いいたします。