В одном столбце таблицы БД заменить все пустые ячейки на содержимое ячеек в другом столбце из той же строки - VB

Узнай цену своей работы

Формулировка задачи:

Добрый день. Есть таблица .dbf и надо в одном столбце заменить все пустые ячейки на содержимое ячеек в другом столбце из той же строки.

Решение задачи: «В одном столбце таблицы БД заменить все пустые ячейки на содержимое ячеек в другом столбце из той же строки»

textual
Листинг программы
Sub Main()
Dim flg             As Boolean
Dim fldNam(1 To 20) As String
Dim fldOff(1 To 20) As String
Dim fldLen(1 To 20) As String
    dbf$ = Application.GetOpenFilename("Файлы dbf,*.dbf", , "Выбирайте файл")
    If UCase$(dbf$) = "FALSE" Or UCase$(dbf$) = "ЛОЖЬ" Then Exit Sub
    fi% = FreeFile
    Open dbf$ For Binary Access Read Write As #fi%
    Seek fi%, 5
    Get #fi%, , Nrec&
    Get #fi%, , OffBeg%
    Get #fi%, , Lrec%
    p& = 33
    n% = 0
    Do
       Seek #fi%, p&
       C11$ = Space$(11)
       Get #fi%, , C11$
       If Left$(C11$, 1) = Chr$(13) Then Exit Do
       n% = n% + 1
       k% = InStr(C11$, Chr$(0))
       If k% = 0 Then
          fldNam(n%) = C11$
       Else
          fldNam(n%) = Left(C11$, k% - 1)
       End If
       tmp$ = " "
       Get #fi%, , tmp$
       Get #fi%, , Off&
       Get #fi%, , ll%
       fldOff(n%) = Off& + 1
       fldLen(n%) = ll%
       p& = p& + 32
    Loop
    For i% = 1 To n%
        If UCase$(fldNam(i%)) = "NPRIK" Then
           Off_Nprik% = fldOff(i%)
           Len_Nprik% = fldLen(i%)
        ElseIf UCase$(fldNam(i%)) = "DATA_PR" Then
           Off_Datapr% = fldOff(i%)
           Len_Datapr% = fldLen(i%)
        ElseIf UCase$(fldNam(i%)) = "DATN" Then
           Off_Datn% = fldOff(i%)
           Len_Datn% = fldLen(i%)
        End If
    Next i%
    Seek #fi%, OffBeg% + 1
    For iii& = 1 To Nrec&
        Application.StatusBar = "Обработка записи " + CStr(iii&)
        Buf$ = Space$(Lrec%)
        Get #fi%, , Buf$
        flg = False
        If Mid$(Buf$, Off_Nprik%, Len_Nprik%) = Space$(Len_Nprik%) Then
           Mid$(Buf$, Off_Nprik%, 1) = "-"
           flg = True
        End If
        If Mid$(Buf$, Off_Datapr%, Len_Datapr%) = Space$(Len_Datapr%) Then
           Mid$(Buf$, Off_Datapr%, Len_Datapr%) = Mid$(Buf$, Off_Datn%, Len_Datn%)
           flg = True
        End If
        If flg Then
           ppp& = Loc(fi%)
           Seek fi%, ppp& - Lrec% + 1
           Put #fi%, , Buf$
        End If
    Next iii&
    Close #fi%
    Application.StatusBar = ""
    MsgBox "Готово!"
End Sub

Оцени полезность:

7   голосов , оценка 3.714 из 5
Похожие ответы