Excel VBA質問箱 IV

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

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


2971 / 13646 ツリー ←次へ | 前へ→

【64966】一覧表のデータを別シートに転記したい。 AAA 10/3/30(火) 21:20 質問[未読]
【64967】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/3/30(火) 22:01 回答[未読]
【64972】一覧表のデータを別シートに転記したい。 AAA 10/3/31(水) 13:10 質問[未読]
【64973】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/3/31(水) 14:04 回答[未読]
【64974】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/3/31(水) 14:25 発言[未読]
【64975】一覧表のデータを別シートに転記したい。 AAA 10/3/31(水) 14:42 質問[未読]
【64976】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/3/31(水) 15:00 回答[未読]
【64977】Re:一覧表のデータを別シートに転記したい。 AAA 10/3/31(水) 15:04 質問[未読]
【64978】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/3/31(水) 15:08 回答[未読]
【64979】Re:一覧表のデータを別シートに転記したい。 AAA 10/3/31(水) 15:17 質問[未読]
【64980】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/3/31(水) 15:33 回答[未読]
【64982】一覧表のデータを別シートに転記したい。 AAA 10/3/31(水) 15:59 質問[未読]
【64983】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/3/31(水) 16:17 回答[未読]
【64984】一覧表のデータを別シートに転記したい。 AAA 10/3/31(水) 16:33 質問[未読]
【64986】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/3/31(水) 17:31 回答[未読]
【64992】Re:一覧表のデータを別シートに転記したい。 AAA 10/3/31(水) 20:26 お礼[未読]
【64993】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/3/31(水) 20:53 回答[未読]
【64994】Re:一覧表のデータを別シートに転記したい。 AAA 10/3/31(水) 21:06 お礼[未読]
【65004】一覧表のデータを別シートに転記したい。 AAA 10/4/1(木) 16:41 質問[未読]
【65009】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/4/1(木) 17:35 回答[未読]
【65016】Re:一覧表のデータを別シートに転記したい。 Hirofumi 10/4/2(金) 0:31 回答[未読]
【65017】一覧表のデータを別シートに転記したい。 AAA 10/4/2(金) 8:48 お礼[未読]

【64966】一覧表のデータを別シートに転記したい。
質問  AAA  - 10/3/30(火) 21:20 -

引用なし
パスワード
   一覧表シートから依頼職場毎に自動で別シートに転記したいのですがマクロをどうやって作ればいいでしょうか?(出来ればファイルを開けた時に自動更新してほしいです。)
一覧表にA〜BMまでデータが入っていて、データはどんどん追加されていきます。
各依頼職場に依頼者からBMまでの全て転記したいです。
A列のNo.とB列依頼職場のデータは不要。
データは項目がA7でA8セルから始まり、転記したいシートもA8から始まるようにしたいです。

VBA初心者なんでお手数ですが詳しく教えて頂ければ有難いです。


【一覧表】シート
  A   B    C   D   E   F   ・・・・・BM      
7  No. 依頼職場 依頼者 工事No. 機番 工事内容 ・・・・・etc
8  1   ○    村田   
9  2   □    高尾
10 3   △    谷口
11 4   ○    成瀬
12 5   □    藤岡
13
14


【依頼職場○】シート
   A   B   C   D   E   F   ・・・・・BK 
7 依頼者 工事No. 機番 工事内容 ・・・・・etc
8  村田   
9  成瀬

【依頼職場□】シート
   A   B   C   D   E   F   ・・・・・BK  
7 依頼者 工事No. 機番 工事内容 ・・・・・etc
8  高尾   
9  藤岡

【依頼職場△】シート

   A   B   C   D   E   F   ・・・・・BK    
7 依頼者 工事No. 機番 工事内容 ・・・・・etc
8  谷口

【64967】Re:一覧表のデータを別シートに転記したい。
回答  Hirofumi  - 10/3/30(火) 22:01 -

引用なし
パスワード
   こんなのでは?

追加されたデータだけ転記するのは、追加分と前回分を分けるのが面倒なので
常に一覧表の先頭から振り分ける様にして有ります
依頼職場シートが無い場合は追加され、
有った場合は、コードが実行される度にクリアされ使い回されます

一覧表には、列見出しが有る物とします
データは、A列〜BM列の65列とし、転記するグループは、B列に有るとします
作業列としてBN列を使用します
実行時にB列で整列され終了直前に元の行位置に再整列されます

Option Explicit

Public Sub Sample_1()

  '元々のデータ列数(A列〜BM列)
  Const clngColumns As Long = 65
  'グループの有る列(B列のA列からの列Offset)
  Const clngGroup As Long = 1
  '結果出力の先頭位置
  Const cstrTop As String = "A7"
  
  Dim i As Long
  Dim lngRows As Long
  Dim lngTop As Long
  Dim lngCount As Long
  Dim rngList As Range
  Dim rngResult As Range
  Dim vntGroup As Variant
  Dim strProm As String

  'Listの先頭セル位置を基準とする(A列の列見出しのセル位置)
  Set rngList = Worksheets("一覧表").Range("A7")

  '画面更新を停止
  Application.ScreenUpdating = False
  
  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row, clngGroup).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '復帰用整列Keyを作成
    With .Offset(1, clngColumns)
      .Value = 1
      .Resize(lngRows).DataSeries _
          Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
          Step:=1, Trend:=False
    End With
    'データをA列で整列
    DataSort .Offset(1).Resize(lngRows, clngColumns + 1), .Offset(, clngGroup)
    'A列データを配列に取得
    vntGroup = .Offset(1, clngGroup).Resize(lngRows + 1).Value
  End With
  
  '仮に結果と元表を同じにして置く
  Set rngResult = rngList
  '注目値の位置を記録
  lngTop = 1
  'データ行数のカウント初期値
  lngCount = 1
  For i = 2 To lngRows + 1
    '注目値と現在値が違った場合
    If vntGroup(lngTop, 1) <> vntGroup(i, 1) Then
      'シート名の存在確認をして、無い場合追加し在る場合はデータ消去
      GetSheets "依頼職場_" & vntGroup(lngTop, 1), cstrTop, rngResult
      With rngList
        '列見出しを転記
'        .Offset(, 2).Resize(, clngColumns).Copy Destination:=rngResult
        'データを転記
        .Offset(lngTop, 2).Resize(lngCount, clngColumns).Copy _
            Destination:=rngResult.Offset(1)
      End With
      '注目値の位置を記録
      lngTop = i
      'データ行数のカウント初期値に
      lngCount = 1
    Else
      'データ行数のカウントを更新
      lngCount = lngCount + 1
    End If
  Next i

  With rngList
    '元データを復帰
    DataSort .Offset(1).Resize(lngRows, clngColumns + 1), .Offset(1, clngColumns)
    '復帰用Key列を削除
    .Offset(, clngColumns).EntireColumn.Delete
  End With
   
  strProm = "処理が完了しました"
   
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
   
  Set rngList = Nothing
  Set rngResult = Nothing
   
  MsgBox strProm, vbInformation
     
End Sub

Private Sub DataSort(rngScope As Range, _
          rngKey As Range, _
          Optional lngSortOrder As Long = xlAscending, _
          Optional lngOrientation As Long = xlTopToBottom)

  rngScope.Sort _
      Key1:=rngKey, Order1:=lngSortOrder, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=lngOrientation, SortMethod:=xlStroke

End Sub

Private Sub GetSheets(vntName As Variant, strTop As String, rngResult As Range)
  
  Dim i As Long
  Dim lngRows As Long
  Dim wksMark As Worksheet
  
  'シートの存在確認
  For Each wksMark In Worksheets
    If StrComp(wksMark.Name, vntName, vbTextCompare) = 0 Then
      Exit For
    End If
  Next wksMark
  'もし、シートが無いなら
  If wksMark Is Nothing Then
    'シートを追加して、シート名を設定
    Set wksMark = Worksheets.Add(After:=rngResult.Parent)
    wksMark.Name = vntName
  Else
    'データを消去
    wksMark.UsedRange.ClearComments
  End If
  
  Set rngResult = wksMark.Range(strTop)
  
  Set wksMark = Nothing
  
End Sub

【64972】一覧表のデータを別シートに転記したい。
質問  AAA  - 10/3/31(水) 13:10 -

引用なし
パスワード
   実行しても上手く行かなくて、MsgBox strProm, vbInformationのところでデバックのカーソル行の前まで実行をした際に実行エラー'1004':アプリケーション定義またはオブジェクト定義のエラーですと表示されます。
何故でしょうか?

【64973】Re:一覧表のデータを別シートに転記したい。
回答  Hirofumi  - 10/3/31(水) 14:04 -

引用なし
パスワード
   ▼AAA さん:
>実行しても上手く行かなくて、MsgBox strProm, vbInformationのところでデバックのカーソル行の前まで実行をした際に実行エラー'1004':アプリケーション定義またはオブジェクト定義のエラーですと表示されます。
>何故でしょうか?

一応コードは簡単なTestをしてUpしています
何か、コードをいじりましたか?
このコードは、標準モジュールに記述していますか?

AAA さんが記述した、モジュールのコードをUpして見て下さい

【64974】Re:一覧表のデータを別シートに転記したい。
発言  Hirofumi  - 10/3/31(水) 14:25 -

引用なし
パスワード
   Excelの画面から
「ツール」→「マクロ」→「マクロ」
でダイアログが出ますのでSample_1を選択して実行して見て下さい

【64975】一覧表のデータを別シートに転記したい。
質問  AAA  - 10/3/31(水) 14:42 -

引用なし
パスワード
   DAtesortが2ヶ所あるんですけどその2ヶ所でエラーが出てるみたいなんですけど・・・

【64976】Re:一覧表のデータを別シートに転記したい。
回答  Hirofumi  - 10/3/31(水) 15:00 -

引用なし
パスワード
   ▼AAA さん:
>DAtesortが2ヶ所あるんですけどその2ヶ所でエラーが出てるみたいなんですけど・・・

DAtesortて何????

そこら辺のコードをUpしてくれませんか??
如何なっているのかさっぱり解りません

【64977】Re:一覧表のデータを別シートに転記したい。
質問  AAA  - 10/3/31(水) 15:04 -

引用なし
パスワード
       'データをA列で整列
    DataSort .Offset(1).Resize(lngRows, clngColumns + 1), .Offset(, clngGroup)
  

    '元データを復帰
    DataSort .Offset(1).Resize(lngRows, clngColumns + 1), .Offset(1, clngColumns)
   
この2ヶ所をコメント(’)にするとプログラムは正常に動きます。

【64978】Re:一覧表のデータを別シートに転記したい。
回答  Hirofumi  - 10/3/31(水) 15:08 -

引用なし
パスワード
   >>DAtesortが2ヶ所あるんですけどその2ヶ所でエラーが出てるみたいなんですけど・・・
>
DAtesortて、DataSortの事ですか?
ひょっとして、以下の2つのプロシージャが無い(記述漏れ)のでは?

Private Sub DataSort(rngScope As Range, _
          rngKey As Range, _
          Optional lngSortOrder As Long = xlAscending, _
          Optional lngOrientation As Long = xlTopToBottom)

  rngScope.Sort _
      Key1:=rngKey, Order1:=lngSortOrder, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=lngOrientation, SortMethod:=xlStroke

End Sub

Private Sub GetSheets(vntName As Variant, strTop As String, rngResult As Range)
 
  Dim i As Long
  Dim lngRows As Long
  Dim wksMark As Worksheet
 
  'シートの存在確認
  For Each wksMark In Worksheets
    If StrComp(wksMark.Name, vntName, vbTextCompare) = 0 Then
      Exit For
    End If
  Next wksMark
  'もし、シートが無いなら
  If wksMark Is Nothing Then
    'シートを追加して、シート名を設定
    Set wksMark = Worksheets.Add(After:=rngResult.Parent)
    wksMark.Name = vntName
  Else
    'データを消去
    wksMark.UsedRange.ClearComments
  End If
 
  Set rngResult = wksMark.Range(strTop)
 
  Set wksMark = Nothing
 
End Sub

【64979】Re:一覧表のデータを別シートに転記したい。
質問  AAA  - 10/3/31(水) 15:17 -

引用なし
パスワード
   一応全てコピーして貼り付けしているのでモレは無いと思います。
エクセルのバージョンとか設定の問題があるのでしょうか??

【64980】Re:一覧表のデータを別シートに転記したい。
回答  Hirofumi  - 10/3/31(水) 15:33 -

引用なし
パスワード
   >一応全てコピーして貼り付けしているのでモレは無いと思います。
>エクセルのバージョンとか設定の問題があるのでしょうか??

特に設定は有りませんし
Excelのバージョンも97〜2007で問題無いとおもいます

もう一度、エラー内容を教えて下さい

【64982】一覧表のデータを別シートに転記したい。
質問  AAA  - 10/3/31(水) 15:59 -

引用なし
パスワード
   DataSortの2ヶ所に「'」を付けて実行すると正常に実行しましたと出ます。
元の状態で実行すると実行時エラー'1004':アプリケーション定義またはオブジェクト定義のエラーですと表示されます。

【64983】Re:一覧表のデータを別シートに転記したい。
回答  Hirofumi  - 10/3/31(水) 16:17 -

引用なし
パスワード
   >DataSortの2ヶ所に「'」を付けて実行すると正常に実行しましたと出ます。
>元の状態で実行すると実行時エラー'1004':アプリケーション定義またはオブジェクト定義のエラーですと表示されます。

「DataSortの2ヶ所」と言うのは以下の所だと思います

    End With
    'データをA列で整列
    DataSort .Offset(1).Resize(lngRows, clngColumns + 1), .Offset(, clngGroup)
    'A列データを配列に取得
    vntGroup = .Offset(1, clngGroup).Resize(lngRows + 1).Value



  With rngList
    '元データを復帰
    DataSort .Offset(1).Resize(lngRows, clngColumns + 1), .Offset(1, clngColumns)
    '復帰用Key列を削除

ここで、「実行時エラー'1004':アプリケーション定義またはオブジェクト定義のエラー」と成るのは
多分、lngRowsの値が0、若しくはclngColumns + 1の値が0と思われますが?
clngColumnsの値を-1以下にしなければ成らないし?
lngRowsが0の場合は、

    '行数の取得
    lngRows = .Offset(Rows.Count - .Row, clngGroup).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If

この部分でエラー対策を行って居ます

因って、コードの記述で記述漏れを起こしているのではと思われます
記述したコードをUpして見て下さい
また、記述しているモジュール(標準モジュール?、シートモジュール?)を教えて下さい

【64984】一覧表のデータを別シートに転記したい。
質問  AAA  - 10/3/31(水) 16:33 -

引用なし
パスワード
   一覧表というシート(Sheet1)に下記のデータを貼り付けてました。
これをシートモジュールと言うんですかね?
詳しくないのですいません・・・

Option Explicit

Public Sub Sample_1()

  '元々のデータ列数(A列〜BM列)
  Const clngColumns As Long = 65
  'グループの有る列(B列のA列からの列Offset)
  Const clngGroup As Long = 1
  '結果出力の先頭位置
  Const cstrTop As String = "A7"
 
  Dim i As Long
  Dim lngRows As Long
  Dim lngTop As Long
  Dim lngCount As Long
  Dim rngList As Range
  Dim rngResult As Range
  Dim vntGroup As Variant
  Dim strProm As String

  'Listの先頭セル位置を基準とする(A列の列見出しのセル位置)
  Set rngList = Worksheets("一覧表").Range("A7")

  '画面更新を停止
  Application.ScreenUpdating = False
 
  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row, clngGroup).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    '復帰用整列Keyを作成
    With .Offset(1, clngColumns)
      .Value = 1
      .Resize(lngRows).DataSeries _
          Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
          Step:=1, Trend:=False
    End With
    'データをA列で整列
    DataSort .Offset(1).Resize(lngRows, clngColumns + 1), .Offset(, clngGroup)
    'A列データを配列に取得
    vntGroup = .Offset(1, clngGroup).Resize(lngRows + 1).Value
  End With
 
  '仮に結果と元表を同じにして置く
  Set rngResult = rngList
  '注目値の位置を記録
  lngTop = 1
  'データ行数のカウント初期値
  lngCount = 1
  For i = 2 To lngRows + 1
    '注目値と現在値が違った場合
    If vntGroup(lngTop, 1) <> vntGroup(i, 1) Then
      'シート名の存在確認をして、無い場合追加し在る場合はデータ消去
      GetSheets "依頼職場_" & vntGroup(lngTop, 1), cstrTop, rngResult
      With rngList
        '列見出しを転記
'        .Offset(, 2).Resize(, clngColumns).Copy Destination:=rngResult
        'データを転記
        .Offset(lngTop, 2).Resize(lngCount, clngColumns).Copy _
            Destination:=rngResult.Offset(1)
      End With
      '注目値の位置を記録
      lngTop = i
      'データ行数のカウント初期値に
      lngCount = 1
    Else
      'データ行数のカウントを更新
      lngCount = lngCount + 1
    End If
  Next i

  With rngList
    '元データを復帰
    DataSort .Offset(1).Resize(lngRows, clngColumns + 1), .Offset(1, clngColumns)
    '復帰用Key列を削除
    .Offset(, clngColumns).EntireColumn.Delete
  End With
 
  strProm = "処理が完了しました"
 
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
 
  Set rngList = Nothing
  Set rngResult = Nothing
 
  MsgBox strProm, vbInformation
  
End Sub
Private Sub DataSort(rngScope As Range, _
          rngKey As Range, _
          Optional lngSortOrder As Long = xlAscending, _
          Optional lngOrientation As Long = xlTopToBottom)

  rngScope.Sort _
      Key1:=rngKey, Order1:=lngSortOrder, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=lngOrientation, SortMethod:=xlStroke

End Sub

Private Sub GetSheets(vntName As Variant, strTop As String, rngResult As Range)

  Dim i As Long
  Dim lngRows As Long
  Dim wksMark As Worksheet

  'シートの存在確認
  For Each wksMark In Worksheets
    If StrComp(wksMark.Name, vntName, vbTextCompare) = 0 Then
      Exit For
    End If
  Next wksMark
  'もし、シートが無いなら
  If wksMark Is Nothing Then
    'シートを追加して、シート名を設定
    Set wksMark = Worksheets.Add(After:=rngResult.Parent)
    wksMark.Name = vntName
  Else
    'データを消去
    wksMark.UsedRange.ClearComments
  End If

  Set rngResult = wksMark.Range(strTop)

  Set wksMark = Nothing

End Sub

【64986】Re:一覧表のデータを別シートに転記したい。
回答  Hirofumi  - 10/3/31(水) 17:31 -

引用なし
パスワード
   >  一覧表というシート(Sheet1)に下記のデータを貼り付けてました。
>これをシートモジュールと言うんですかね?
>詳しくないのですいません・・・

Upされたコードで試しましたが、そのようなエラーは出ませんでした
一応、シートモジュールに記述しても動く様には書いて有るはずなのですが?
本来はVBE画面で、「挿入」→「標準モジュール」で追加される標準モジュールに
記述する事を想定して書いて有ります
因って、其処に移して下さい

ただ、エラーの原因は解りません、と言うよりあり得ない事象だと思います?
前のレスに記述した様に、エラーの内容からすると、多分

1、
  '元々のデータ列数(A列〜BM列)
  Const clngColumns As Long = 65

の記述をマイナスに変更したか?
2、
「lngRows = 0」をDataSortの前に挿入したか?
3、
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If

を削除して、且つB列にデータが無いか?

名のですが、其れを行っている気配も有りません
原因不明です?

其れと、このコードの実行方法はどのように実行していますか?
全てのコードを同じ「標準モジュール」に記述して、
VBEのメニューから「デバッグ」→「VBProjectのコンパイル」をして保存
其れから、Exceの画面に戻り「ツール」→「マクロ」→「マクロ」で
ダイアログを出して、Sample_1を選択し実行として見て下さい

【64992】Re:一覧表のデータを別シートに転記したい。
お礼  AAA  - 10/3/31(水) 20:26 -

引用なし
パスワード
   其れと、このコードの実行方法はどのように実行していますか?
全てのコードを同じ「標準モジュール」に記述して、
VBEのメニューから「デバッグ」→「VBProjectのコンパイル」をして保存
其れから、Exceの画面に戻り「ツール」→「マクロ」→「マクロ」で
ダイアログを出して、Sample_1を選択し実行として見て下さい

上記の内容で最初からやり直してみたら上手くいきました。
VBEのメニューから「デバッグ」→「VBProjectのコンパイル」をして保存をしてませんでした。
それ以外は上記のやり方でした。

後もう1つこれが原因かは不明なんですが一部結合してたセルがあってそれを解除して上記の内容でやったら上手くいきました。

何度も×2丁寧にご対応して頂きありがとうございました。
これを機にさらに勉強しないといけないなぁと思いました。
本当に×2ありがとうございました。

【64993】Re:一覧表のデータを別シートに転記したい。
回答  Hirofumi  - 10/3/31(水) 20:53 -

引用なし
パスワード
   >後もう1つこれが原因かは不明なんですが一部結合してたセルがあってそれを解除して上記の内容でやったら上手くいきました。

あ!!
此れも原因の一つだと思います
整列を使っていますので、結合セルが有ると整列でエラーが出るかも解りません
それと、マクロ全般に就いて、結合セルが有るとOffset等で位置の取得が
上手く行きません
因って、マクロの質問をする時は、結合セルが有るならどの範囲に有るかを
申告して下さい
大抵は、結合セルに就いて考慮はしていないと思います

【64994】Re:一覧表のデータを別シートに転記したい。
お礼  AAA  - 10/3/31(水) 21:06 -

引用なし
パスワード
   結合セルを全然気にしてませんでした・・・
訳のわからない事を言ってしまってすいませんでした。
次質問する際は結合セルが有るとかもう少し詳しく説明できるように気をつけます。

本当にありがとうございました。

【65004】一覧表のデータを別シートに転記したい。
質問  AAA  - 10/4/1(木) 16:41 -

引用なし
パスワード
   たびたびすいません・・・

現状は一覧表のC(依頼者)〜BMまでを職場事に転記してるんですが、
B(依頼職場)〜BMまでを転記したいのですが

 End With
    'データをA列で整列
    DataSort .Offset(1).Resize(lngRows, clngColumns + 1), .Offset(, clngGroup)
    'A列データを配列に取得
    vntGroup = .Offset(1, clngGroup).Resize(lngRows + 1).Value
  End With
 
  '仮に結果と元表を同じにして置く
  Set rngResult = rngList
  '注目値の位置を記録
  lngTop = 1
  'データ行数のカウント初期値
  lngCount = 1
  For i = 2 To lngRows + 1
    '注目値と現在値が違った場合
    If vntGroup(lngTop, 1) <> vntGroup(i, 1) Then
      'シート名の存在確認をして、無い場合追加し在る場合はデータ消去
      GetSheets "依頼職場_" & vntGroup(lngTop, 1), cstrTop, rngResult
      With rngList
        '列見出しを転記
'        .Offset(, 2).Resize(, clngColumns).Copy Destination:=rngResult
        'データを転記
        .Offset(lngTop, 2).Resize(lngCount, clngColumns).Copy _
            Destination:=rngResult.Offset(1)
      End With
      '注目値の位置を記録
      lngTop = i
      'データ行数のカウント初期値に
      lngCount = 1
    Else
      'データ行数のカウントを更新
      lngCount = lngCount + 1
    End If
  Next i

  With rngList
    '元データを復帰
    DataSort .Offset(1).Resize(lngRows, clngColumns + 1), .Offset(1, clngColumns)
    '復帰用Key列を削除
    .Offset(, clngColumns).EntireColumn.Delete
  End With

のどこを変更したらB(依頼職場)からBM列まで表示されるのでしょうか?
ほんと全然分かってなくて申し訳ありませんがよろしくお願いします。

【65009】Re:一覧表のデータを別シートに転記したい。
回答  Hirofumi  - 10/4/1(木) 17:35 -

引用なし
パスワード
   >現状は一覧表のC(依頼者)〜BMまでを職場事に転記してるんですが、
>B(依頼職場)〜BMまでを転記したいのですが

>のどこを変更したらB(依頼職場)からBM列まで表示されるのでしょうか?
>ほんと全然分かってなくて申し訳ありませんがよろしくお願いします。

      GetSheets "依頼職場_" & vntGroup(lngTop, 1), cstrTop, rngResult
      With rngList
        '列見出しを転記(列見出しが必要なら以下を活かす)
'        .Offset(, 2).Resize(, clngColumns).Copy Destination:=rngResult
        .Offset(, 1).Resize(, clngColumns).Copy Destination:=rngResult '★4/1変更
        'データを転記
'        .Offset(lngTop, 2).Resize(lngCount, clngColumns).Copy _
            Destination:=rngResult.Offset(1)
        .Offset(lngTop, 1).Resize(lngCount, clngColumns).Copy _
            Destination:=rngResult.Offset(1)            '★4/1変更
      End With
      '注目値の位置を記録
      lngTop = i
      'データ行数のカウント初期値に
      lngCount = 1

★印の様に2→1に変更して下さい
尚、上の修正部分は、コメントアウトして有ったのですが
活かせば、列見出しが出力されます

【65016】Re:一覧表のデータを別シートに転記したい。
回答  Hirofumi  - 10/4/2(金) 0:31 -

引用なし
パスワード
   ごめん、変更箇所がまだあった

      'シート名の存在確認をして、無い場合追加し在る場合はデータ消去
      GetSheets "依頼職場_" & vntGroup(lngTop, 1), cstrTop, rngResult
      With rngList
        '列見出しを転記(列見出しが必要なら以下を活かす)
'        .Offset(, 2).Resize(, clngColumns).Copy Destination:=rngResult
        .Offset(, 1).Resize(, clngColumns - 1).Copy Destination:=rngResult '★4/1変更
        'データを転記
'        .Offset(lngTop, 2).Resize(lngCount, clngColumns).Copy _
            Destination:=rngResult.Offset(1)
        .Offset(lngTop, 1).Resize(lngCount, clngColumns - 1).Copy _
            Destination:=rngResult.Offset(1)            '★4/1変更
      End With


「clngColumns」から-1して下さい(総列数から1つ列が少なく成るのですから)

【65017】一覧表のデータを別シートに転記したい。
お礼  AAA  - 10/4/2(金) 8:48 -

引用なし
パスワード
   今実行しました。

すごくいいものが出来ました。

これからちょっとずつでも勉強します!!

ありがとうございました。

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