Re: Supprimer les espaces d'une cellule |
Titre du sujet : Re: Supprimer les espaces d'une cellule par Razmo le 26/01/2023 17:14:21 Re,
J'ai pensé à faire une boucle de ce type : For Each MesCellules In MaPlage 'Étape 5: supprimer les espaces If Not IsEmpty(MesCellules) Then MesCellules = Trim(MesCellules) End If Mais si c'est ça ici "MesCellules" sont DIFF_DTC_H.Offset(1, 0) et "MaPlage" serait quoi ?
Mon code source si besoin : Public Sub DiagMatrixCheck() Dim MATRIX_WB As Workbook Dim MATRIX_WS As Worksheet Dim DIFF_WS As Worksheet Dim DIFF_WB As Workbook Dim counter As Long Dim column As Integer Dim MATRIX_LABEL_H As Range, MATRIX_DETECT_H As Range, MATRIX_STATE_H As Range, MATRIX_DTC_H As Range Dim MATRIX_LABEL As Range, MATRIX_DETECT As Range, MATRIX_STATE As Range, MATRIX_DTC As Range Dim DIFF_DETECT_H As Range, DIFF_DETECT As Range, PREV_DIAG As Range, DIFF_LABEL_H As Range, DIFF_DTC_H As Range, DIFF_STATE_H As Range Dim XML_FILE As String, XML_LABEL As String, XML_DETECT As String, PCODE As String, MATRIX_FILE As String Dim XDOC As DOMDocument60 Dim SHORT_NAME, LONG_NAME, V_NAME, INSTANCE As Object Dim i As Integer Dim DebugText As String Dim MATRIX_LABEL_H_Datas As Range, MATRIX_DETECT_H_Datas As Range, MATRIX_STATE_H_Datas As Range, MATRIX_DTC_H_Datas As Range Dim nbLignDatas& On Error GoTo ErrorHandler 'Application.ScreenUpdating = False Sheets("Diff").UsedRange.Offset(2, 0).ClearContents 'Delete all comments 'Cells.ClearComments 'Open Excel Diag Matrix file MATRIX_FILE = Application.GetOpenFilename(FileFilter:="Excel File (*.xls*), *.xls*", Title:="Open Excel File") Set MATRIX_WB = Workbooks.Open(Filename:=MATRIX_FILE, ReadOnly:=False) Set MATRIX_WS = MATRIX_WB.Sheets("Matrix") Set DIFF_WB = ThisWorkbook Set DIFF_WS = DIFF_WB.Sheets("Diff") 'Set the header for every used column of the matrix With MATRIX_WS Set MATRIX_LABEL_H = .Range("A6").EntireRow.Find("Supplier Label") Set MATRIX_DETECT_H = .Range("A6").EntireRow.Find("Detection Class") Set MATRIX_STATE_H = .Range("A6").EntireRow.Find("State of the activation of the strategy") Set MATRIX_DTC_H = .Range("A6").EntireRow.Find("Data Trouble Code (DTC)") 'set Datas range for these columns nbLignDatas = .Cells(.Rows.Count, MATRIX_LABEL_H.column).End(xlUp).Row - 6 'because header online 6 Set MATRIX_LABEL_H_Datas = MATRIX_LABEL_H.Resize(nbLignDatas, 1).Offset(1, 0) nbLignDatas = .Cells(.Rows.Count, MATRIX_DETECT_H.column).End(xlUp).Row - 6 'because header online 6 Set MATRIX_DETECT_H_Datas = MATRIX_DETECT_H.Resize(nbLignDatas, 1).Offset(1, 0) nbLignDatas = .Cells(.Rows.Count, MATRIX_STATE_H.column).End(xlUp).Row - 6 'because header online 6 Set MATRIX_STATE_H_Datas = MATRIX_STATE_H.Resize(nbLignDatas, 1).Offset(1, 0) nbLignDatas = .Cells(.Rows.Count, MATRIX_DTC_H.column).End(xlUp).Row - 6 'because header online 6 Set MATRIX_DTC_H_Datas = MATRIX_DTC_H.Resize(nbLignDatas, 1).Offset(1, 0) End With 'Define variables for Diff tab Set DIFF_DETECT_H = DIFF_WS.Range("A2").EntireRow.Find("Detection Class") Set DIFF_LABEL_H = DIFF_WS.Range("A2").EntireRow.Find("Supplier Label") Set DIFF_DTC_H = DIFF_WS.Range("A2").EntireRow.Find("DTC code") Set DIFF_STATE_H = DIFF_WS.Range("A2").EntireRow.Find("Activation state") counter = ActiveCell.Row column = ActiveCell.column 'Copy and paste column Matrix to Diff 'Copy that cell values without comments MATRIX_LABEL_H_Datas.Copy 'Destination:=DIFF_LABEL_H.Offset(1, 0) DIFF_LABEL_H.Offset(1, 0).PasteSpecial Paste:=xlPasteValues MATRIX_DETECT_H_Datas.Copy 'Destination:=DIFF_DETECT_H.Offset(1, 0) DIFF_DETECT_H.Offset(1, 0).PasteSpecial Paste:=xlPasteValues MATRIX_STATE_H_Datas.Copy 'Destination:=DIFF_STATE_H.Offset(1, 0) DIFF_STATE_H.Offset(1, 0).PasteSpecial Paste:=xlPasteValues MATRIX_DTC_H_Datas.Copy 'Destination:=DIFF_DTC_H.Offset(1, 0) DIFF_DTC_H.Offset(1, 0).PasteSpecial Paste:=xlPasteValues 'DIFF_DTC_H.Offset(1, 0).Value = Trim(DIFF_DTC_H.Offset(0, 3)) 'DIFF_DTC_H.Offset(1, 0).Value = LTrim(Cells(counter, column).Value) DIFF_DETECT_H.Resize(nbLignDatas, 1).Offset(1, 1).Value = "Missing item in XML"
|
Forums