1

ここにいくつかのコードがありますが、これはうまく機能していますが、微調整したいと思います。現在、マクロは3行の値を新しいブックにコピーします。これらの値は、フォーマットなしで貼り付けられます。列幅が十分に大きくない場合があるため、セルのすべてのコンテンツが表示されるわけではありません。私の質問は次のとおりです。貼り付けた最初の行のテキストに応じて列が大きくなるように、以下のコードを変更するにはどうすればよいですか。
最初の行の内容に応じて列を自動調整するにはどうすればよいですか？

コード：

Public Sub pub_sub_ExportRows()

'#
'# declare private variables
'#
     Dim pvt_xls_Current As Excel.Worksheet
     Dim pvt_wbk_New As Excel.Workbook
     Dim pvt_lng_SelectedSourceRow As Long
     Dim pvt_flg_ValidRow As Boolean
     Dim pvt_lng_RowNumber As Long
     Dim pvt_lng_FirstColumn As Long
     Dim pvt_lng_LastColumn As Long
     Dim pvt_lng_ColumnNumber As Long
     Dim pvt_lng_TargetColumn As Long

'#
'# record the current row based on the active cell
'#
     Set pvt_xls_Current = ThisWorkbook.ActiveSheet
     pvt_lng_SelectedSourceRow = ActiveCell.Row

'#
'# the maximum number of columns to be considered is not dependent on the columns        defined in the
'# worksheet, but rather by a limit imposed by the user - i.e. column HG is the last       column to be copied,
'# and column Q is the first column to be considered
'#
     pvt_lng_FirstColumn = Columns("Q").Column
     pvt_lng_LastColumn = Columns("HG").Column
     pvt_lng_TargetColumn = 0

'#
'# check if the selected row is valid by examining the values in the columns on that
'# row - any non-blank value implies that the selected row is valid - when looking at
'# the values the search starts in column Q as requested by the user
'#
     With pvt_xls_Current
          pvt_flg_ValidRow = False
          For pvt_lng_ColumnNumber = pvt_lng_FirstColumn To pvt_lng_LastColumn
               If LenB(.Cells(pvt_lng_SelectedSourceRow, pvt_lng_ColumnNumber).Value) > 0 Then
                    pvt_flg_ValidRow = True
                    Exit For
               End If
          Next pvt_lng_ColumnNumber
     End With

     If Not pvt_flg_ValidRow Then
          MsgBox "You must select a valid - i.e. non empty - row"
          Exit Sub
     End If

     If pvt_lng_SelectSourceRow > 10000 Then
          MsgBox "You may not select a row > 10000"
          Exit Sub
     End If

'#
'# create a new workbook to hold the copied values and copy & paste the information to   the
'# newly created workbook
'#
     Set pvt_wbk_New = Application.Workbooks.Add
     With pvt_xls_Current
          For pvt_lng_ColumnNumber = pvt_lng_FirstColumn To pvt_lng_LastColumn

               If LenB(.Cells(pvt_lng_SelectedSourceRow, pvt_lng_ColumnNumber).Value) > 0 And _
                    InStr(1, "$AF,$BF,$CG,$DH,$ES,$FV,$HD,$HF",    Split(Columns(pvt_lng_ColumnNumber).Address, ":")(0)) = 0 Then
                         pvt_lng_TargetColumn = pvt_lng_TargetColumn + 1
                         pvt_wbk_New.Worksheets("Sheet1").Cells(1,    pvt_lng_TargetColumn).Value = .Cells(4, pvt_lng_ColumnNumber).Value
                         pvt_wbk_New.Worksheets("Sheet1").Cells(2,   pvt_lng_TargetColumn).Value = .Cells(5, pvt_lng_ColumnNumber).Value
                         pvt_wbk_New.Worksheets("Sheet1").Cells(3,  pvt_lng_TargetColumn).Value = .Cells(pvt_lng_SelectedSourceRow, pvt_lng_ColumnNumber).Value
               End If

          Next pvt_lng_ColumnNumber
     End With

'#
'# activate the new workbook
'#
     pvt_wbk_New.Activate
End Sub
4

1 に答える 1

3

これにより、値に設定されている最初のセルの行全体が自動調整されます。行1を示すだけで明らかに簡略化できますが、使用したコードを複製しようとしました。 

 pvt_wbk_New.Worksheets("Sheet1").Cells(1,pvt_lng_TargetColumn).EntireRow.Columns.Autofit
于 2013-01-02T15:59:38.630 に答える