Hỏi về xóa số liệu nằm ở giữa? (1 người xem)

  • Thread starter Thread starter nad582
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
nad582

nad582

Thành viên thường trực
Tham gia
7/6/11
Bài viết
317
Được thích
48
Chào các a(c) GPE, e có vấn đề sau:
- đầu tiên e có bảng số liệu, tại 2 cột B và C (cột B là tên, cột C là số)
- tại cột C có số liệu ứng với cột B
-trong cột C có số nhỏ nhất và lớn nhất
vậy yêu cầu: là xóa các dòng (số trung gian) nằm giữa số nhỏ nhất và số lớn nhất
ví dụ:
xoa.jpg
kết quả:
ketqua.jpg
mong các a(c) chỉ giúp....chân thành cảm ơn....mong hồi đáp....
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
nad582 đã viết:
Chào các a(c) GPE, e có vấn đề sau:
- đầu tiên e có bảng số liệu, tại 2 cột B và C (cột B là tên, cột C là số)
- tại cột C có số liệu ứng với cột B
-trong cột C có số nhỏ nhất và lớn nhất
vậy yêu cầu: là xóa các dòng (số trung gian) nằm giữa số nhỏ nhất và số lớn nhất
ví dụ:
View attachment 125245
kết quả:
View attachment 125246
mong các a(c) chỉ giúp....chân thành cảm ơn....mong hồi đáp....
Nhấp chuột vào đây để mở rộng...

Chọn dòng 13, dùng Auto Filter (Data > Filter > Auto Filter), vào mũi tên hình tam giác ngay C13, click vào chọn số cần xóa và xóa hết các dòng đã chọn, xong chọn All để trả lại thử xem.
 
Upvote 0
be09 đã viết:
Chọn dòng 13, dùng Auto Filter (Data > Filter > Auto Filter), vào mũi tên hình tam giác ngay C13, click vào chọn số cần xóa và xóa hết các dòng đã chọn, xong chọn All để trả lại thử xem.
Nhấp chuột vào đây để mở rộng...
Cách trên e có thể làm được nhưng nếu số liệu nhiều thì lọc bằng tay hơi lâu,
nên để thuận tiện cho việc với số liệu nhiều,....e nhờ a(c) viết giúp e code VBA !!chân thành cảm ơn
 
Upvote 0
nad582 đã viết:
Chào các a(c) GPE, e có vấn đề sau:
- đầu tiên e có bảng số liệu, tại 2 cột B và C (cột B là tên, cột C là số)
- tại cột C có số liệu ứng với cột B
-trong cột C có số nhỏ nhất và lớn nhất
vậy yêu cầu: là xóa các dòng (số trung gian) nằm giữa số nhỏ nhất và số lớn nhất
ví dụ:
View attachment 125245
kết quả:
View attachment 125246
mong các a(c) chỉ giúp....chân thành cảm ơn....mong hồi đáp....
Nhấp chuột vào đây để mở rộng...
Xài tạm code này nếu chưa có cách gọn hơn
PHP: 
Sub MiddleDelete()
Dim Data(), Res(1 To 10000, 1 To 8)
Dim Tem(1 To 10000, 1 To 3), i, ii, j, k, kk, ID
Data = Range([A4], [H65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(Data)
      ID = Data(i, 1) & Data(i, 2)
      If Not .exists(ID) Then
         k = k + 1
         .Add ID, k
         Tem(k, 1) = ID
         Tem(k, 2) = Data(i, 2)
         Tem(k, 3) = Data(i, 3)
      Else
         If Tem(k, 2) > Data(i, 3) Then Tem(k, 2) = Data(i, 3)
         If Tem(k, 3) < Data(i, 3) Then Tem(k, 3) = Data(i, 3)
      End If
   Next
   For i = 1 To UBound(Data)
      ID = Data(i, 1) & Data(i, 2)
       ii = .Item(ID)
      If ID = Tem(ii, 1) Then
         If Data(i, 3) = Tem(ii, 2) Or Data(i, 3) = Tem(ii, 3) Then
            kk = kk + 1
            For j = 1 To 8
               Res(kk, j) = Data(i, j)
            Next
         End If
      End If
   Next
End With
[I4].Resize(kk, 8) = Res
End Sub
 
Upvote 0
Mình cũng vừa xong 1 cách củ chuối hột

Bạn tham khảo xem sao.
 

File đính kèm

Upvote 0
quanghai1969 đã viết:
Xài tạm code này nếu chưa có cách gọn hơn
PHP: 
Sub MiddleDelete()
Dim Data(), Res(1 To 10000, 1 To 8)
Dim Tem(1 To 10000, 1 To 3), i, ii, j, k, kk, ID
Data = Range([A4], [H65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(Data)
      ID = Data(i, 1) & Data(i, 2)
      If Not .exists(ID) Then
         k = k + 1
         .Add ID, k
         Tem(k, 1) = ID
         Tem(k, 2) = Data(i, 2)
         Tem(k, 3) = Data(i, 3)
      Else
         If Tem(k, 2) > Data(i, 3) Then Tem(k, 2) = Data(i, 3)
         If Tem(k, 3) < Data(i, 3) Then Tem(k, 3) = Data(i, 3)
      End If
   Next
   For i = 1 To UBound(Data)
      ID = Data(i, 1) & Data(i, 2)
       ii = .Item(ID)
      If ID = Tem(ii, 1) Then
         If Data(i, 3) = Tem(ii, 2) Or Data(i, 3) = Tem(ii, 3) Then
            kk = kk + 1
            For j = 1 To 8
               Res(kk, j) = Data(i, j)
            Next
         End If
      End If
   Next
End With
[I4].Resize(kk, 8) = Res
End Sub
Nhấp chuột vào đây để mở rộng...
Kết quả của a rất tốt nhưng a điều chỉnh một chút giúp e:
- kết quả cuối cùng nằm tại ô A14 (không phải I14...............>> [I4].Resize(kk, 8) = Res)
- kết quả kèm theo border ví dụ:
vidu.jpg
Chân thành cảm ơn a rất nhiều!!
 
Upvote 0
nad582 đã viết:
Kết quả của a rất tốt nhưng a điều chỉnh một chút giúp e:
- kết quả cuối cùng nằm tại ô A14 (không phải I14...............>> [I4].Resize(kk, 8) = Res)
- kết quả kèm theo border ví dụ:
View attachment 125259
Chân thành cảm ơn a rất nhiều!!
Nhấp chuột vào đây để mở rộng...
Mình nghĩ bạn có thế sửa code lại mà
PHP: 
Sub MiddleDelete()
Dim Data(), Res(1 To 10000, 1 To 8)
Dim Tem(1 To 10000, 1 To 3), i, ii, j, k, kk, ID
With Sheets("gialap")
   Data = .Range(.[A4], .[H65536].End(3)).Value
End With
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(Data)
      ID = Data(i, 1) & Data(i, 2)
      If Not .exists(ID) Then
         k = k + 1
         .Add ID, k
         Tem(k, 1) = ID
         Tem(k, 2) = Data(i, 2)
         Tem(k, 3) = Data(i, 3)
      Else
         If Tem(k, 2) > Data(i, 3) Then Tem(k, 2) = Data(i, 3)
         If Tem(k, 3) < Data(i, 3) Then Tem(k, 3) = Data(i, 3)
      End If
   Next
   For i = 1 To UBound(Data)
      ID = Data(i, 1) & Data(i, 2)
       ii = .Item(ID)
      If ID = Tem(ii, 1) Then
         If Data(i, 3) = Tem(ii, 2) Or Data(i, 3) = Tem(ii, 3) Then
            kk = kk + 1
            For j = 1 To 8
               Res(kk, j) = Data(i, j)
            Next
         End If
      End If
   Next
End With
With Sheets("ketquagialap")
   .[A14:H10000].Clear
   .[A14].Resize(kk, 8) = Res
   .[A14].CurrentRegion.Borders.Value = 1
End With
End Sub
 
Upvote 0
quanghai1969 đã viết:
Mình nghĩ bạn có thế sửa code lại mà
PHP: 
Sub MiddleDelete()
Dim Data(), Res(1 To 10000, 1 To 8)
Dim Tem(1 To 10000, 1 To 3), i, ii, j, k, kk, ID
With Sheets("gialap")
   Data = .Range(.[A4], .[H65536].End(3)).Value
End With
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(Data)
      ID = Data(i, 1) & Data(i, 2)
      If Not .exists(ID) Then
         k = k + 1
         .Add ID, k
         Tem(k, 1) = ID
         Tem(k, 2) = Data(i, 2)
         Tem(k, 3) = Data(i, 3)
      Else
         If Tem(k, 2) > Data(i, 3) Then Tem(k, 2) = Data(i, 3)
         If Tem(k, 3) < Data(i, 3) Then Tem(k, 3) = Data(i, 3)
      End If
   Next
   For i = 1 To UBound(Data)
      ID = Data(i, 1) & Data(i, 2)
       ii = .Item(ID)
      If ID = Tem(ii, 1) Then
         If Data(i, 3) = Tem(ii, 2) Or Data(i, 3) = Tem(ii, 3) Then
            kk = kk + 1
            For j = 1 To 8
               Res(kk, j) = Data(i, j)
            Next
         End If
      End If
   Next
End With
With Sheets("ketquagialap")
   .[A14:H10000].Clear
   .[A14].Resize(kk, 8) = Res
   .[A14].CurrentRegion.Borders.Value = 1
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Chào a, a hiệu chỉnh giúp e vấn đề này: lúc đầu e đã định dạng bảng dữ liệu rồi, nhưng khi chạy sub xong thì mất định dạng, vậy có thể nào khi chạy sub xong thì định dạng vẫn giữ nguyên được không?
Chân thành cảm ơn!!
vùng định dạng rồiaaaaa.jpg,
chạy sub xong thì ko còn định dạngbbbbbbbbbbbb.jpg
 
Upvote 0
nad582 đã viết:
Chào a, a hiệu chỉnh giúp e vấn đề này: lúc đầu e đã định dạng bảng dữ liệu rồi, nhưng khi chạy sub xong thì mất định dạng, vậy có thể nào khi chạy sub xong thì định dạng vẫn giữ nguyên được không?
Chân thành cảm ơn!!
vùng định dạng rồiView attachment 125261,
chạy sub xong thì ko còn định dạngView attachment 125262
Nhấp chuột vào đây để mở rộng...
Chỉ có 1 cột C thôi phải không
Tìm và thay chỗ code này
PHP: 
With Sheets("ketquagialap")
   .[A14:H10000].Clear
   .[A14].Resize(kk, 8) = Res
   .[C14].Resize(kk).NumberFormat = "0.00"
   .[A14].CurrentRegion.Borders.Value = 1
End With
 
Upvote 0
quanghai1969 đã viết:
Chỉ có 1 cột C thôi phải không
Tìm và thay chỗ code này
PHP: 
With Sheets("ketquagialap")
   .[A14:H10000].Clear
   .[A14].Resize(kk, 8) = Res
   .[C14].Resize(kk).NumberFormat = "0.00"
   .[A14].CurrentRegion.Borders.Value = 1
End With
Nhấp chuột vào đây để mở rộng...
Dạ cột C thì can giữa và sau dấu phẩy 2 số 0
cột E đến H thì sau dấu phẩy 3 số 0
có phải hiệu chỉnh giống như code bên trên ko!!
vậy nếu cột có can giữa và có dấu % phía sau thì làm thế nào!! (ví dụ cột I, vì code trên e có thể tùy chỉnh 1 chút)
(nó hơi nhiều 1 tý...anh thông cảm)
chân thành cảm ơn
 
Upvote 0
Upvote 0
chuot0106 đã viết:
Bạn tìm dòng code sau :

Data = .Range(.[A4], .[H65536].End(3)).Value


và thay bằng dòng code này xem sao. tôi chưa thử!




Data = .Range(.[A4], .[H65536].End(3)).Formula
Nhấp chuột vào đây để mở rộng...

e vừa thử xong, nhưng nó vẫn vậy a ak, vẫn không giữ nguyên được định dạng...
nhờ a hiệu chỉnh giúp...
 
Upvote 0
Của bạn đây:

Mã: 
Sub MiddleDelete()
Dim Data(), Res(1 To 10000, 1 To 8)
Dim Tem(1 To 10000, 1 To 3), i, ii, j, k, kk, ID
With Sheets("gialap")
   Data = .Range(.[A4], .[H65536].End(3)).Value
End With
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(Data)
      ID = Data(i, 1) & Data(i, 2)
      If Not .exists(ID) Then
         k = k + 1
         .Add ID, k
         Tem(k, 1) = ID
         Tem(k, 2) = Data(i, 2)
         Tem(k, 3) = Data(i, 3)
      Else
         If Tem(k, 2) > Data(i, 3) Then Tem(k, 2) = Data(i, 3)
         If Tem(k, 3) < Data(i, 3) Then Tem(k, 3) = Data(i, 3)
      End If
   Next
   For i = 1 To UBound(Data)
      ID = Data(i, 1) & Data(i, 2)
       ii = .Item(ID)
      If ID = Tem(ii, 1) Then
         If Data(i, 3) = Tem(ii, 2) Or Data(i, 3) = Tem(ii, 3) Then
            kk = kk + 1
            For j = 1 To 8
               Res(kk, j) = Data(i, j)
            Next
         End If
      End If
   Next
End With
With Sheets("ketquagialap")
   .[A14:H10000].Clear
   .[A14].Resize(kk, 8) = Res
   .[A14].CurrentRegion.Borders.Value = 1
End With
[COLOR=#ff0000]    Sheet1.Range("A14:H15").Copy[/COLOR]
[COLOR=#ff0000]    Sheet2.Range("A24:H" & Sheet2.Range("H65500").End(xlUp).Row).PasteSpecial xlPasteFormats[/COLOR]
[COLOR=#ff0000]    Application.CutCopyMode = False[/COLOR]
End Sub
 
Upvote 0
nad582 đã viết:
Dạ cột C thì can giữa và sau dấu phẩy 2 số 0
cột E đến H thì sau dấu phẩy 3 số 0
có phải hiệu chỉnh giống như code bên trên ko!!
vậy nếu cột có can giữa và có dấu % phía sau thì làm thế nào!! (ví dụ cột I, vì code trên e có thể tùy chỉnh 1 chút)
(nó hơi nhiều 1 tý...anh thông cảm)
chân thành cảm ơn
Nhấp chuột vào đây để mở rộng...
Mấy cái này là chuyện nhỏ thôi
PHP: 
With Sheets("ketquagialap")
   .[A14:H10000].Clear
   .[A14].Resize(kk, 8) = Res
   .[C14].Resize(kk).NumberFormat = "0.00"
   '.[C14].Resize(kk).Style = "Percent" 'dong này là định dạng %, khi nào muốn thì bỏ cái dấu nháy phía trước
   .[C14].Resize(kk).HorizontalAlignment = xlCenter
   .[E14:H14].Resize(kk).NumberFormat = "0.000"
   .[A14].CurrentRegion.Borders.Value = 1
End With
 
Upvote 0
quanghai1969 đã viết:
Mấy cái này là chuyện nhỏ thôi
PHP: 
With Sheets("ketquagialap")
   .[A14:H10000].Clear
   .[A14].Resize(kk, 8) = Res
   .[C14].Resize(kk).NumberFormat = "0.00"
   '.[C14].Resize(kk).Style = "Percent" 'dong này là định dạng %, khi nào muốn thì bỏ cái dấu nháy phía trước
   .[C14].Resize(kk).HorizontalAlignment = xlCenter
   .[E14:H14].Resize(kk).NumberFormat = "0.000"
   .[A14].CurrentRegion.Borders.Value = 1
End With
Nhấp chuột vào đây để mở rộng...
Gì mà dài dữ vậy anh? Chỉ cần lấy định dạng của bảng cũ cho bảng mới là ok thôi mà! Như em thêm ở code trên của anh đó.
 
Upvote 0
quanghai1969 đã viết:
Mấy cái này là chuyện nhỏ thôi
PHP: 
With Sheets("ketquagialap")
   .[A14:H10000].Clear
   .[A14].Resize(kk, 8) = Res
   .[C14].Resize(kk).NumberFormat = "0.00"
   '.[C14].Resize(kk).Style = "Percent" 'dong này là định dạng %, khi nào muốn thì bỏ cái dấu nháy phía trước
   .[C14].Resize(kk).HorizontalAlignment = xlCenter
   .[E14:H14].Resize(kk).NumberFormat = "0.000"
   .[A14].CurrentRegion.Borders.Value = 1
End With
Nhấp chuột vào đây để mở rộng...
Cách của anh quanghai1969 có thể tùy chỉnh tại sheets"gialap", vì e muốn thực hiện ngay trên sheet luôn không cần phải sang sheet khác (sheet "ketquagialap")
cách của a chuot0106 thì e ko biết hiệu chỉnh khi sub ngay tại sheet (e biến đổi sheet "ketquagialap" thành sheets"gialap"thì vẫn ko giữ nguyên định dạng)
cảm ơn các a rất nhiều, nếu như có cách rút gọn code lại thì hồi đáp cho e (ko cần thiết lập nhiều mà có thể giữ nguyên định dạng của nó)....
chân thành cảm ơn...
 
Upvote 0
nad582 đã viết:
Cách của anh quanghai1969 có thể tùy chỉnh tại sheets"gialap", vì e muốn thực hiện ngay trên sheet luôn không cần phải sang sheet khác (sheet "ketquagialap")
cách của a chuot0106 thì e ko biết hiệu chỉnh khi sub ngay tại sheet (e biến đổi sheet "ketquagialap" thành sheets"gialap"thì vẫn ko giữ nguyên định dạng)
cảm ơn các a rất nhiều, nếu như có cách rút gọn code lại thì hồi đáp cho e (ko cần thiết lập nhiều mà có thể giữ nguyên định dạng của nó)....
chân thành cảm ơn...
Nhấp chuột vào đây để mở rộng...
Có 1 cách là sẽ rút gọn code. Định dạng trước các cột tại nơi xuất dữ liệu. Thế thôi.
 
Upvote 0
quanghai1969 đã viết:
Có 1 cách là sẽ rút gọn code. Định dạng trước các cột tại nơi xuất dữ liệu. Thế thôi.
Nhấp chuột vào đây để mở rộng...
Như vậy e muốn nó xuất hiện ở sheet "gialap" thì định dạng các cột tại sheet "gialap" đúng ko anh.
nhưng trong code
With Sheets("ketquagialap")
.[A14:H10000].Clear
chỗ màu đỏ e thay bằng "gialap", nhưng còn chữ clear thì nó lại xóa hết định dạng rồi....
(e chỉ nêu ý kiến học hỏi thôi chứ không cố ý nói nhiều...mong a thông cảm)...
 
Upvote 0
nad582 đã viết:
Như vậy e muốn nó xuất hiện ở sheet "gialap" thì định dạng các cột tại sheet "gialap" đúng ko anh.
nhưng trong code
With Sheets("ketquagialap")
.[A14:H10000].Clear
chỗ màu đỏ e thay bằng "gialap", nhưng còn chữ clear thì nó lại xóa hết định dạng rồi....
(e chỉ nêu ý kiến học hỏi thôi chứ không cố ý nói nhiều...mong a thông cảm)...
Nhấp chuột vào đây để mở rộng...
Cứ thay thử và chạy code, không đúng thì thay thử và chạy tiếp. Sửa riết rồi tự nhiên biết. Mình cũng theo cách này thôi. Không tin thì xem lại những bài đầu tiền mình hỏi khi mới tham gia diễn đàn. Toàn những câu hỏi rất đơn giản.
 
Upvote 0
Dạng bài này có 2 cách giải, xóa thật & xóa "giả bộ"
Xóa "giả bộ" là dùng vòng lặp kiểm tra em nào không thỏa điều kiện để xóa thì "lụm" bỏ vào mảng, xong xuôi thì "phang" cái mảng đó xuống sheet. Chơi kiểu này chạy cái "roẹt" là xong nhưng kết quả lấy được là value thôi. Nếu chủ topic muốn giữ lại các định dạng phức tạp & muốn kết quả ra tại ngay vùng chứa dữ liệu nguồn thì chơi......xóa thật thôi, khỏi suy nghĩ về định dạng cho nhức đầu
Híc, suy nghĩ là thế, hổng biết trúng trật & cũng hổng biết làm nữa
+-+-+-+Híc+-+-+-+
 
Lần chỉnh sửa cuối:
Upvote 0
concogia đã viết:
Dạng bài này ó 2 cách giải, xóa thật & xóa "giả bộ"
Xóa "giả bộ" là dùng vòng lặp kiểm tra em nào không thỏa điều kiện để xóa thì "lụm" bỏ vào mảng, xong xuôi thì "phang" cái mảng đó xuống sheet. Chơi kiểu này chạy cái "roẹt" là xong nhưng kết quả lấy được là value thôi. Nếu chủ topi muốn giữ lại các định dạng phức tạp & muốn kết quả ra tại ngay vùng chứa dữ liệu nguồn thì chơi......xóa thật thôi, khỏi suy nghĩ về định dạng cho nhức đầu
Híc, suy nghĩ là thế, hổng biết trúng trật & cũng hổng biết làm nữa
+-+-+-+Híc+-+-+-+
Nhấp chuột vào đây để mở rộng...
em nghĩ là xóa thật, khi đã định dạng tất cả các cột rồi, khi chạy sub thì delete luôn dòng trung gian..vậy giữ lại được định dạng ban đầu..!!
hichic
 
Upvote 0
concogia đã viết:
Dạng bài này có 2 cách giải, xóa thật & xóa "giả bộ"
Xóa "giả bộ" là dùng vòng lặp kiểm tra em nào không thỏa điều kiện để xóa thì "lụm" bỏ vào mảng, xong xuôi thì "phang" cái mảng đó xuống sheet. Chơi kiểu này chạy cái "roẹt" là xong nhưng kết quả lấy được là value thôi. Nếu chủ topic muốn giữ lại các định dạng phức tạp & muốn kết quả ra tại ngay vùng chứa dữ liệu nguồn thì chơi......xóa thật thôi, khỏi suy nghĩ về định dạng cho nhức đầu
Híc, suy nghĩ là thế, hổng biết trúng trật & cũng hổng biết làm nữa
+-+-+-+Híc+-+-+-+
Nhấp chuột vào đây để mở rộng...
Định dạng có khó gì đâu hả anh. Chỉ cần copy dòng đầu trong dữ liệu cũ, đập vào vùng mới là được rồi. Tại em muốn chạy lòng vòng cho vui thôi. Tính em vẫn thế mà. Biết đấy, nhưng vẫn để cho hỏi cho vui... he he
 
Upvote 0
quanghai1969 đã viết:
Định dạng có khó gì đâu hả anh. Chỉ cần copy dòng đầu trong dữ liệu cũ, đập vào vùng mới là được rồi. Tại em muốn chạy lòng vòng cho vui thôi. Tính em vẫn thế mà. Biết đấy, nhưng vẫn để cho hỏi cho vui... he he
Nhấp chuột vào đây để mở rộng...
a quanghai1969 cũng vui tính hể!! vậy a giúp e rút gọn code lại luôn nhe...!! vấn đề là chạy sub tại sheet hiện hành mà vẫn giữ nguyên được định dạng của nó...!!
chân thành cảm ơn!!
 
Upvote 0
nad582 đã viết:
a quanghai1969 cũng vui tính hể!! vậy a giúp e rút gọn code lại luôn nhe...!! vấn đề là chạy sub tại sheet hiện hành mà vẫn giữ nguyên được định dạng của nó...!!
chân thành cảm ơn!!
Nhấp chuột vào đây để mở rộng...
Nguồn chỗ nào, đích đến chỗ nào. Ai biết đâu mà lần chứ.
 
Upvote 0
quanghai1969 đã viết:
Nguồn chỗ nào, đích đến chỗ nào. Ai biết đâu mà lần chứ.
Nhấp chuột vào đây để mở rộng...
Nguổn vẫn là Sheets("gialap") đích vẫn là Sheets("gialap")
quanghai1969 đã viết:
Định dạng có khó gì đâu hả anh. Chỉ cần copy dòng đầu trong dữ liệu cũ, đập vào vùng mới là được rồi.
Nhấp chuột vào đây để mở rộng...
nếu như ý anh là vầy thì e chừa dòng 13 là dòng đã định dạng rồi, như vậy khi xử lý số liệu từ dòng 14 trở xuống thì tất cả các định dạng dòng phía dưới sẽ đi theo dòng 13....
 
Upvote 0
nad582 đã viết:
Nguổn vẫn là Sheets("gialap") đích vẫn là Sheets("gialap")

nếu như ý anh là vầy thì e chừa dòng 13 là dòng đã định dạng rồi, như vậy khi xử lý số liệu từ dòng 14 trở xuống thì tất cả các định dạng dòng phía dưới sẽ đi theo dòng 13....
Nhấp chuột vào đây để mở rộng...
Hỏng hiểu, làm đại, hỏng trúng tính tiếp. Hỏi nhiều mắc công giận.
PHP: 
Sub MiddleDelete()
Dim Data(), Res(1 To 10000, 1 To 8)
Dim Tem(1 To 10000, 1 To 3), i, ii, j, k, kk, ID
With Sheets("gialap")
   Data = .Range(.[A4], .[H65536].End(3)).Value
    With CreateObject("scripting.dictionary")
       For i = 1 To UBound(Data)
          ID = Data(i, 1) & Data(i, 2)
          If Not .exists(ID) Then
             k = k + 1
             .Add ID, k
             Tem(k, 1) = ID
             Tem(k, 2) = Data(i, 2)
             Tem(k, 3) = Data(i, 3)
          Else
             If Tem(k, 2) > Data(i, 3) Then Tem(k, 2) = Data(i, 3)
             If Tem(k, 3) < Data(i, 3) Then Tem(k, 3) = Data(i, 3)
          End If
       Next
       For i = 1 To UBound(Data)
          ID = Data(i, 1) & Data(i, 2)
           ii = .Item(ID)
          If ID = Tem(ii, 1) Then
             If Data(i, 3) = Tem(ii, 2) Or Data(i, 3) = Tem(ii, 3) Then
                kk = kk + 1
                For j = 1 To 8
                   Res(kk, j) = Data(i, j)
                Next
             End If
          End If
       Next
    End With
    .[J4:Q10000].Clear
    .[J4].Resize(kk, 8) = Res
    .[A4:H4].Copy
    .[J4].Resize(kk, 8).PasteSpecial 4
End With
End Sub
 
Upvote 0
quanghai1969 đã viết:
Hỏng hiểu, làm đại, hỏng trúng tính tiếp. Hỏi nhiều mắc công giận.
Nhấp chuột vào đây để mở rộng...
E là người hỏi mà, anh không trách thì thôi chứ sao dám...
đối với code a sửa lại, thì e có thể tùy chỉnh đối với bài của em:

Dim Data(), Res(1 To 10000, 1 To 8)
Dim Tem(1 To 10000, 1 To 3), i, ii, j, k, kk, ID
With Sheets("gialap")
Data = .Range(.[A14], .[H65000].End(3)).Value
With CreateObject("scripting.dictionary")
For i = 1 To UBound(Data)
ID = Data(i, 1) & Data(i, 2)
If Not .exists(ID) Then
k = k + 1
.Add ID, k
Tem(k, 1) = ID
Tem(k, 2) = Data(i, 2)
Tem(k, 3) = Data(i, 3)
Else
If Tem(k, 2) > Data(i, 3) Then Tem(k, 2) = Data(i, 3)
If Tem(k, 3) < Data(i, 3) Then Tem(k, 3) = Data(i, 3)
End If
Next
For i = 1 To UBound(Data)
ID = Data(i, 1) & Data(i, 2)
ii = .Item(ID)
If ID = Tem(ii, 1) Then
If Data(i, 3) = Tem(ii, 2) Or Data(i, 3) = Tem(ii, 3) Then
kk = kk + 1
For j = 1 To 8
Res(kk, j) = Data(i, j)
Next
End If
End If
Next
End With
.[A14:H65000].Clear
.[A14].Resize(kk, 8) = Res
.[A13:H13].Copy
.[A14].Resize(kk, 8).PasteSpecial 4
End With


chân thành cảm ơn anh, nếu có đến Cần Thơ thì pm cho e nhé...Thank you!!
 
Upvote 0
Chào a(c) trong GPE, e có câu hỏi thứ 2 liên quan đến đề bài trên....về lọc giá trị sau khi a quanghai1969 đã giúp e câu hỏi số 1, vậy e nên đặt câu hỏi tại đề tài này hay là phải tạo đề tài khác vậy!! xin cảm ơn!!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

V
Gộp File Từng File Excel vào 1 File (2 người xem)
Trả lời
1
Đọc
73
ptm0412
ptm0412
V
Quản lý xuất nhập vật tư trong kho (1 người xem)
Trả lời
8
Đọc
215
LOGANWover
L
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD (2 người xem)
    • Thích
Trả lời
25
Đọc
1K
HUONGHCKT
H
N
Tạo COM Add-In bằng Visual C++ (2 người xem)
    • Thích
Trả lời
11
Đọc
1K
Tuanba1992
Tuanba1992
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (5 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
425
Đọc
55K
Hoàng Tuấn 868
H
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng
Trả lời
19
Đọc
2K
Hà Tiềm
H
Nguyễn Duy Tuân
PHƯƠNG PHÁP TRÍCH XUẤT NGƯỢC BÁO CÁO - Drilldown và Add-in A-Tools
    • Thích
Trả lời
1
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
phuongnam366377
VbaTools – Bộ công cụ mở rộng cho VBA trong Excel (1 người xem)
    • Thích
Trả lời
37
Đọc
978
YêuCN
Y
ptm0412
Hàm XLOOKUP: Có thể bạn chưa biết hết tính năng và ứng dụng
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
24
Đọc
15K
nguyen huu tai
N
H
Tổng hợp Công Nợ theo Công trình
Trả lời
47
Đọc
907
HangktGTN
H
queluatb
Tự động tăng số hóa đơn theo điều kiện
Trả lời
3
Đọc
99
HieuCD
H
Sơn Cận
Mẫu theo dõi hoạt động đội xe vận tải
Trả lời
0
Đọc
57
Sơn Cận
Sơn Cận
GPE-Trợ Lý
TALKSHOW 16 BẬT MÍ THỦ THUẬT GOOGLE SHEET: TỔNG HỢP DỮ LIỆU TỪ NHIỀU SHEET & FILE BĂNG IMPORTRANGE
Trả lời
0
Đọc
161
GPE-Trợ Lý
GPE-Trợ Lý
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ !
Trả lời
6
Đọc
320
huhumalu
H
D
Lỗi khi sử dụng Excel bị dính chuột trái ( chỉ dùng Excel mới bị )
Trả lời
14
Đọc
17K
SonXD85
S
thanhss
Tự động lấy dữ liệu từ các sheet khác đưa vào sheet tổng hợp khi chọn Ngày hoặc tháng hoặc năm
Trả lời
24
Đọc
679
thanhss
thanhss
D
nhờ các bác tạo giúp e một file ghi nhớ và nhắc ngày thu tiền ạ
    • Ngạc nhiên
    • Cười
Trả lời
0
Đọc
114
duongdaicb
D
B
Mình có làm đoạn code VBA trong file access mà cứ báo lỗi nhờ mọi người hướng dẫn
Trả lời
9
Đọc
319
baybley
B
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox
    • Cười
Trả lời
6
Đọc
266
huhumalu
H
H
Excel không lọc được toàn bộ dữ liệu
Trả lời
1
Đọc
158
yeudoi
yeudoi
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom