コードを変更して、はるかに効率的なvbaを作成する

応答2# ->にスキップ

3 #

PaupauD 2020-02-16 21:41

アンドレアス！ありがとうございました.2番目のコードで私が達成しようとしているのは、さまざまなタイプのソートです

自動車メーカーが行をコピーして、それぞれのワークシートに貼り付けます.

ワークシート「ALL」には、さまざまなメーカーがすべて含まれています

次に、ホンダ、トヨタ、メルセデス、ビュイック、フォード、日産のワークシートがあります.

ワークシート「HONDA」にはホンダ車のみを含める必要があります

他の自動車メーカーと同じです.

応答3# ->にスキップ

4 #

Andreas 2020-02-17 02:19

ピボットtable(または通常のtable)を使用してスライサーを使用する方が良いですか.

はるかに動的で高速で、VBAコードは必要ありません...

サンプルファイルをアップロードしたい場合は、データの管理方法を説明します.

onedriveファイルとフォルダを共有する-Officeサポート

アンドレアス.

応答4# ->にスキップ

5 #

PaupauD 2020-02-17 23:26

正しくできたかどうかはわかりません.これがコードを含むファイルです.
私の同僚は私が何をしているかを見ました.彼らは私にいくつかの変更と機能を入れるように要求しました.
そして問題があります.私はプログラムを作成するのがあまり得意ではありません.私はコードを減らしたいと思っていました.
vbaの私の基本的な知識Edgeを超えているコードです.
どこから改善を始められるかについての参照があれば非常にありがたいです.

「サマリー」シートに3つのボタンがあります.これは結果、ジョブカードの削除、サマリーの削除です.
「ジョブカードの削除」を押すと、既存のすべての行(ヘッダーを除く)が削除されます概要以外のワークシート.
最初のステップは、ワークシート「ALL」に生データを最初に入力することです.それは異なります.
毎日

分析するデータが一定ではありません.

結果を押すと、次のようになります.
1)列「C」の値に基づいて、ワークシート「ALL」から行全体を別のワークシートにコピーし、場合によっては列「S」を使用してコピーします
2) P、Q、O、Iの値に基づいて各ワークシートの行を並べ替えます.
3)各ワークシートにセパレーターを作成します.つまり、「事故」、「内訳ジョブカード」、「追加ジョブカード」および「ストレージ」
O、P、Q列の値に基づく

現在のコードの問題:
1)プログラムが「事故」セパレータに属するデータを検出しなかった場合.「故障ジョブカード」セパレータも作成されません.

---

-1つのセパレーターに属するデータがない場合でも、今達成することを望みます.それでもセパレータは作成されますが、その下にデータはありません.
たとえば、「事故」には3行のデータがあり、「内訳ジョブカード」には「追加のジョブカード」と同じゼロがあり、
「ストレージ」セパレータの下には15行あります.
2)シリアル番号を入力することを期待しています.セパレータごとの各ワークシートの列A.シリアルNo.をつけてなんとかできます.しかし、問題は、プログラムが結合されたセルを検出したときに
発生します.
3)このシーケンスに区切り文字を使用する代わりに、「事故」、「内訳ジョブカード」、「追加ジョブカード」、および「ストレージ」.
「事故」、「内訳ジョブカード」、「ストレージ」、「追加ジョブカード」に変更したい

応答5# ->にスキップ

6 #

Andreas 2020-02-18 01:38

大丈夫、ここに私のポイントです:すべてのシートだけを使用しないでください.

データを異なるシートに分割する場合、サマリーシートを難しくします.

コードは必要ありません.2回クリックするだけですべて入手してください.見てください:

少し近くに見える場合は、「区切り文字」という名前の新しい列Lが表示されます.区切り文字の値があります.その列に基づいて、私は条件付き書式をいくつか作成しましたので、各行の「種類」を直接見ることができます.

「ContractCode」と「Depot」という名前のデータの下の「ボックス」はスライサーであり、その機能は実際のtableで利用可能です.あなたが見ることができるように、デポの驚きが表示され、契約コードメルセデスが表示されます.

あなたが近づくならば、デポ "Jebel Ali"が黒のフォントを持っているのを見ることができます、それはJebel AliがContractCode Mercedesにも利用可能です.

そして私はサマリーシートのピボットtableを使用してデータを分析することを提案します、私はあなたにサンプルを表示するためだけに作成しました.ピボットtableは本当に強力なツールで、それを使って遊びます.

これはあなたの変更されたファイルです:

https://www.dropbox.com/s/7yex8d03n9m03vj/b60f7f2c-5320-4570-808d-c9c465bffc36.xlsx?dl=1.

andreas.

応答6# ->にスキップ

7 #

PaupauD 2020-02-18 02:39

vbaを使用しているのは、データを「読み取る」だけの人にとっては簡単だからです.ワークシートを選択して、そのシートのどこに何個あるかを確認するだけで、実際にすばやく確認できます.また、スライサーを使用すると、特別に混乱する可能性があります
Excelファイルの知識が少ない人.場合によっては、デポごとに分離する必要がない場合もあります.ワークシートごとの数.そのため、VBAコードの方がはるかに優れていると思います

ピボットtableの観点から.要約タブは実際にはワークシート「ALL」のデータに依存していないため、チェックします.

見せてくれてありがとう！私の他のプロジェクトではそれを使いません.

応答7# ->にスキップ

8 #

Andreas 2020-02-18 20:261

大丈夫、問題ありません.

すべての側面の妥協点はオートフィルタを使用し、フィルタ処理されたデータをシートから他のシートにコピーすることです.
その順序で順番を持ちたい場合は、すべてのシート内の注文を変更できます.
下のコードを通常のモジュールにコピーして、他のすべてのコード/モジュールを削除します.

オプション




sub filterandcopy()
prepare

prepare

prepareupdating= false
Application.Calculation= XLCalculationManual
Application.EnableVents= false
filterandcopy_primワークシート( "aweer")、 "mercedes"、 "aweer"
filterandcopy_primワークシート( "Jebel Ali")、 "Mercedes*"、 "Jebel Ali"、 "Filterandcopy_primワークシート(" man 2016) ""
filterandcopy_primワークシート( "optare")、 "optare"
filterandcopy_primワークシート( "optare")、 "optare"
filterandcopy_primワークシート( "solaris")、 "solaris"
filterandcopy_primワークシート( "トヨタ」)、「TOYOTA」
FilterandCopy_primワークシート( "VDL")、 "VDL 2019"
filterandcopy_primワークシート( "Volvo")、 "Volvo 2008"
filterandcopy_primワークシート( "Volvo 2019")) volvo 2019 ""
"Application.EnableVents= true
Application.Calculation= true
true


sub filterandcopy_prim(ByVal DestSheetとしてワークシート、オプションの契約コード、オプションl depot)
DIMの区切り文字
DIM DEST AS RANGE
DIM項目、データ
DIM i


区切り文字を設定します.求職 "、"追加求職 "、" Storage ")



''前の結果を消去します.
dest=.range(" a1 ")を設定します(" a1 ")
dest.currentregion.offset(1).crear
ワークシート( "all")










































」 ContractCode)その後
.autofilter.range.autoFilterフィールド:= 2、Criteria1:= ContractCode、演算子:= Xlor、Criteria2:= "="
<"
.autofilter.range.autoFilterフィールド:= 18、Criteria1:=デポ、演算子:= Xlor、Criteria2:= "="

''
'コピー結果
.Range( "A1").currentRegion.copy dest

.showalldata












'
データ=.Range( "A1"、.Range( "A"&.Count).end(xlup))





i= UBound(データ)から2ステップの各行を確認します.-1
'この行に区切り文字がありますか?
区切り記号の各項目には
データ(I、1)=アイテムが
の場合はyes、列のセルです.空の行?
iSempty( "b"&i + 1)の場合、


.br>

次の場合

次の


end sub

を終了します.

√

応答8# ->にスキップ

9 #

PaupauD 2020-02-20 02:14

アンドレアス、ありがとう！しかし、行で型の不一致が発生します

For i=UBound(Data)To 2 Step-1

確認する必要があるもの

先週提供していただいた他のコードをなんとか回避しました

これで、事故、故障、保管、追加のジョブカードの区切り文字に適切なシーケンスがあります
完璧ではありませんが、うまくいきました:

Sub GOODANDBADBANANA(Ws As Worksheet)
Dim CurrentRow As Long、LastRow As Long
Dim CurrentState As State

CurrentRow=1
LastRow=Ws.Range( "B"&Rows.Count).End(xlUp).Row

Do
Select Case Ws.Range( "Q"&CurrentRow).Value
Case "IN"
Select Case Ws.Range( "O"&CurrentRow).Value
Case " BM "
If CurrentState<>Good Then
CurrentState=Good
GoSub InsertRow
End If
Case" CM "
If CurrentState<>Good Then
CurrentState=Good
GoSub InsertRow
End If
Case "CMP"
If CurrentState<>Good Then
CurrentState=Good
GoSub InsertRow
End If
Case "TPM"
If CurrentState<>Good Then
CurrentState=Good
GoSub InsertRow
End If
Case "SP"
If CurrentState<>Good Then
CurrentState=Good
GoSub InsertRow
End If
Case "TPM"
If CurrentState<>Good Then
CurrentState=Good
GoSub InsertRow
End If
End Select
Case Else
If CurrentState<>Unknown Then
CurrentState=Unknown
Exit Sub
End If
End Select
CurrentRow=CurrentRow + 1
Loop Until CurrentRow>LastRow
Exit Sub

InsertRow:
Ws.Range( "B"&CurrentRow).EntireRow.Insert
With Intersect(Ws.Range( "B:U")、Ws.Range( "B"&CurrentRow).EntireRow)
.MergeCells=True
Select Case CurrentState
Case Good
.Value="BREAKDOWN BUSSES"
Case Unknown
.Value="BREAKDOWN BUSSES"
End Select
.Interior.ColorIndex=37
.Font.Name="Verdana"
.Font.ColorIndex=1
.Rows.AutoFit
.HorizontalAlignment=xlCenter
.Font.Bold=True
End With
CurrentRow=CurrentRow + 1
LastRow=LastRow + 1
Return
End Sub

結合されたセルを配置する代わりに、列にシリアル番号を入力することもできました

columnAからcolumnU.columnBからcolumnUに移動し、次に隣接するA列のセルを

同じ色.セルの境界線がなければ合法に見えます.

唯一のハードルは、列Bの結合セルに隣接するセルを無視するA列のシリアル番号の入力方法です

また、このように上からカウントを繰り返します

1
2
	BからUへの結合セル
1
2
3
4
	BからUへの結合セル
1

これを使用している場合:

Sub serialnumber()
For i=2 To Cells(Rows.Count、 "B").End(xlUp).Row

If Cells(i、 "B").Value<>"" Then
Cells(i、 "A").Value=i-1

If If
Next i
End Sub

応答9# ->にスキップ

10 #

Andreas 2020-02-20 03:03

オートフィルタを変更した場合は、「契約コード」と「デポ」の代わりに他の列をフィルタリングした場合が可能です.

元のファイル内に問題が表示されませんでした:

https://www.dropbox.com/s/wi39e7z5u9qgk3s/b60f7f2c-5320-4570-808d-c9c465bffc36.xlsm?dl=1.

マクロを記録し、必要に応じてコード内の列番号(フィールド:=)をカスタマイズします.

.autofilter.range.autoFilterフィールド:= 2、Criteria1:=契約コード、演算子:= Xlor、Criteria2:= "="

andreas.