Em có 2 câu hỏi mong mọi người giúp đỡ
Câu 1: (đã được giải đáp)
Công thức:
Cột A là các dữ liệu dạng text
Em cần đặt công thức ở B1 sao cho: nếu ô A1 có chứa từ "Nợ" hoặc "nợ" hoặc "chậm" hoặc "Chậm" thì ô B1 sẽ điền "X"
Câu 2 về macro
Dưới đây là nguyên mẫu của em (hơi dài nhưng e chỉ hỏi 1 ý đơn giản) mục đích của macro này là copy dữ liệu từ nhiều file tổng hợp lại thành 1 file.
mọi thứ chạy ok, chỉ có 1 vấn đề về định dạng chữ
Giả sử ô P45 ở file gốc có giá trị là "22.550" (tỉ giá USD)
Sau khi copy sang file tổng hợp thì nó lại hiện thành 22.55
Em muốn nó để nguyên thành 22.550
Rất mong đc mọi người giúp đỡ
Câu 1: (đã được giải đáp)
Công thức:
Mã:
=IF(OR(ISNUMBER(FIND("XXX",A1)),ISNUMBER(FIND("yyy",A1)),ISNUMBER(FIND("zzz",data!P717)),ISNUMBER(FIND("yyy",data!P717))),"kết quả","")
Cột A là các dữ liệu dạng text
Em cần đặt công thức ở B1 sao cho: nếu ô A1 có chứa từ "Nợ" hoặc "nợ" hoặc "chậm" hoặc "Chậm" thì ô B1 sẽ điền "X"
Câu 2 về macro
Dưới đây là nguyên mẫu của em (hơi dài nhưng e chỉ hỏi 1 ý đơn giản) mục đích của macro này là copy dữ liệu từ nhiều file tổng hợp lại thành 1 file.
mọi thứ chạy ok, chỉ có 1 vấn đề về định dạng chữ
Giả sử ô P45 ở file gốc có giá trị là "22.550" (tỉ giá USD)
Sau khi copy sang file tổng hợp thì nó lại hiện thành 22.55
Em muốn nó để nguyên thành 22.550
Rất mong đc mọi người giúp đỡ
Mã:
Sub test()
Dim FolderPath As String, FileName As String, strFileTarget As String
Dim wb As Excel.Workbook
Dim i As Integer, lastRow As Integer
Dim DataArr(17) As Variant
FolderPath = Range("A1").Value & "\" 'Duong dan thu muc do tim
FileName = Dir(FolderPath & "*.xls*") 'Tim trong thu muc tat ca cac file *.xls*
strFileTarget = "IMEX - Hung - Copy.xlsm" 'Ten file macro chay
Set FSO = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
If FSO.FolderExists(FolderPath) Then
Do While FileName <> ""
If FileName <> strFileTarget Then
On Error Resume Next
Set wb = Workbooks.Open(FolderPath & FileName)
If Err.Number <> 0 Then: MsgBox ("Unable to open file " & FileName)
On Error GoTo 0
lastRow = Workbooks(strFileTarget).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
' Workbooks(FileName).Worksheets(1).Range(Cells(5, 2), Cells(10, 2)).Copy
' Workbooks(strFileTarget).Worksheets(1).Cells(lastRow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
DataArr(0) = Workbooks(FileName).Worksheets(1).Range("E4").Value: DataArr(1) = Workbooks(FileName).Worksheets(1).Range("I6").Value
DataArr(2) = Workbooks(FileName).Worksheets(1).Range("P6").Value: DataArr(3) = Workbooks(FileName).Worksheets(1).Range("G8").Value
DataArr(4) = Workbooks(FileName).Worksheets(1).Range("H23").Value: DataArr(5) = Workbooks(FileName).Worksheets(1).Range("D31").Value
DataArr(6) = Workbooks(FileName).Worksheets(1).Range("K36").Value: DataArr(7) = Workbooks(FileName).Worksheets(1).Range("P36").Value
DataArr(8) = Workbooks(FileName).Worksheets(1).Range("K37").Value: DataArr(9) = Workbooks(FileName).Worksheets(1).Range("P37").Value
DataArr(10) = Workbooks(FileName).Worksheets(1).Range("U35").Value: DataArr(11) = Workbooks(FileName).Worksheets(1).Range("J41").Value
DataArr(12) = Workbooks(FileName).Worksheets(1).Range("J45").Value: DataArr(13) = Workbooks(FileName).Worksheets(1).Range("P45").Value
DataArr(14) = Workbooks(FileName).Worksheets(1).Range("AB70").Value: DataArr(15) = Workbooks(FileName).Worksheets(1).Range("H68").Value
DataArr(16) = Workbooks(FileName).Worksheets(1).Range("H69").Value
For i = 0 To UBound(DataArr)
Workbooks(strFileTarget).Worksheets(1).Cells(lastRow + 1, i + 1).Value = Trim(DataArr(i))
Next
Application.Wait (Now + TimeValue("0:00:01"))
Workbooks(FileName).Close SaveChanges:=False
End If
FileName = Dir
Loop
Else
MsgBox folder & "Specified Folder Not Found", vbInformation, "Not Found!"
End If
MsgBox ("Well Done!")
Application.ScreenUpdating = True
End Sub
Lần chỉnh sửa cuối: